Summary Table

Categories	Total Count
PII	0
URL	0
DNS	0
EKL	0
IP	0
PORT	0
VsID	0
CF	0
AI	0
VPD	0
PL	0
Other	0

File Content

$KID IB*2.0*631
**INSTALL NAME**
IB*2.0*631
"BLD",11220,0)
IB*2.0*631^INTEGRATED BILLING^0^3190612^y
"BLD",11220,4,0)
^9.64PA^355.36^2
"BLD",11220,4,355.36,0)
355.36
"BLD",11220,4,355.36,222)
y^n^f^^^^n
"BLD",11220,4,365.1,0)
365.1
"BLD",11220,4,365.1,2,0)
^9.641^365.1^1
"BLD",11220,4,365.1,2,365.1,0)
IIV TRANSMISSION QUEUE (File-top level)
"BLD",11220,4,365.1,2,365.1,1,0)
^9.6411^.1^1
"BLD",11220,4,365.1,2,365.1,1,.1,0)
WHICH EXTRACT
"BLD",11220,4,365.1,222)
y^n^p^^^^n^^n
"BLD",11220,4,365.1,224)

"BLD",11220,4,"APDD",365.1,365.1)

"BLD",11220,4,"APDD",365.1,365.1,.1)

"BLD",11220,4,"B",355.36,355.36)

"BLD",11220,4,"B",365.1,365.1)

"BLD",11220,6.3)
11
"BLD",11220,"ABPKG")
n
"BLD",11220,"INIT")
POST^IBY631PO
"BLD",11220,"KRN",0)
^9.67PA^1.61^23
"BLD",11220,"KRN",.4,0)
.4
"BLD",11220,"KRN",.401,0)
.401
"BLD",11220,"KRN",.402,0)
.402
"BLD",11220,"KRN",.403,0)
.403
"BLD",11220,"KRN",.5,0)
.5
"BLD",11220,"KRN",.84,0)
.84
"BLD",11220,"KRN",1.6,0)
1.6
"BLD",11220,"KRN",1.61,0)
1.61
"BLD",11220,"KRN",1.62,0)
1.62
"BLD",11220,"KRN",3.6,0)
3.6
"BLD",11220,"KRN",3.8,0)
3.8
"BLD",11220,"KRN",9.2,0)
9.2
"BLD",11220,"KRN",9.8,0)
9.8
"BLD",11220,"KRN",9.8,"NM",0)
^9.68A^14^14
"BLD",11220,"KRN",9.8,"NM",1,0)
IBCEOB01^^0^B26160583
"BLD",11220,"KRN",9.8,"NM",2,0)
IBCNSJ51^^0^B64267141
"BLD",11220,"KRN",9.8,"NM",3,0)
IBCNERTU^^0^B8303401
"BLD",11220,"KRN",9.8,"NM",4,0)
IBCNERTQ^^0^B51002672
"BLD",11220,"KRN",9.8,"NM",5,0)
IBCNEQU^^0^B176309456
"BLD",11220,"KRN",9.8,"NM",6,0)
IBCNEHLM^^0^B24245896
"BLD",11220,"KRN",9.8,"NM",7,0)
IBCNEHLQ^^0^B108956868
"BLD",11220,"KRN",9.8,"NM",8,0)
IBCNERP8^^0^B111034768
"BLD",11220,"KRN",9.8,"NM",9,0)
IBY631PO^^0^B6066647
"BLD",11220,"KRN",9.8,"NM",10,0)
IBCNEHL1^^0^B212831000
"BLD",11220,"KRN",9.8,"NM",11,0)
IBCNSM3^^0^B16082217
"BLD",11220,"KRN",9.8,"NM",12,0)
IBCNEMS1^^0^B11188278
"BLD",11220,"KRN",9.8,"NM",13,0)
IBCNBLL^^0^B178996455
"BLD",11220,"KRN",9.8,"NM",14,0)
IBCNRDV^^0^B146805068
"BLD",11220,"KRN",9.8,"NM","B","IBCEOB01",1)

"BLD",11220,"KRN",9.8,"NM","B","IBCNBLL",13)

"BLD",11220,"KRN",9.8,"NM","B","IBCNEHL1",10)

"BLD",11220,"KRN",9.8,"NM","B","IBCNEHLM",6)

"BLD",11220,"KRN",9.8,"NM","B","IBCNEHLQ",7)

"BLD",11220,"KRN",9.8,"NM","B","IBCNEMS1",12)

"BLD",11220,"KRN",9.8,"NM","B","IBCNEQU",5)

"BLD",11220,"KRN",9.8,"NM","B","IBCNERP8",8)

"BLD",11220,"KRN",9.8,"NM","B","IBCNERTQ",4)

"BLD",11220,"KRN",9.8,"NM","B","IBCNERTU",3)

"BLD",11220,"KRN",9.8,"NM","B","IBCNRDV",14)

"BLD",11220,"KRN",9.8,"NM","B","IBCNSJ51",2)

"BLD",11220,"KRN",9.8,"NM","B","IBCNSM3",11)

"BLD",11220,"KRN",9.8,"NM","B","IBY631PO",9)

"BLD",11220,"KRN",19,0)
19
"BLD",11220,"KRN",19.1,0)
19.1
"BLD",11220,"KRN",101,0)
101
"BLD",11220,"KRN",409.61,0)
409.61
"BLD",11220,"KRN",771,0)
771
"BLD",11220,"KRN",779.2,0)
779.2
"BLD",11220,"KRN",870,0)
870
"BLD",11220,"KRN",8989.51,0)
8989.51
"BLD",11220,"KRN",8989.52,0)
8989.52
"BLD",11220,"KRN",8994,0)
8994
"BLD",11220,"KRN",8994,"NM",0)
^9.68A^^
"BLD",11220,"KRN","B",.4,.4)

"BLD",11220,"KRN","B",.401,.401)

"BLD",11220,"KRN","B",.402,.402)

"BLD",11220,"KRN","B",.403,.403)

"BLD",11220,"KRN","B",.5,.5)

"BLD",11220,"KRN","B",.84,.84)

"BLD",11220,"KRN","B",1.6,1.6)

"BLD",11220,"KRN","B",1.61,1.61)

"BLD",11220,"KRN","B",1.62,1.62)

"BLD",11220,"KRN","B",3.6,3.6)

"BLD",11220,"KRN","B",3.8,3.8)

"BLD",11220,"KRN","B",9.2,9.2)

"BLD",11220,"KRN","B",9.8,9.8)

"BLD",11220,"KRN","B",19,19)

"BLD",11220,"KRN","B",19.1,19.1)

"BLD",11220,"KRN","B",101,101)

"BLD",11220,"KRN","B",409.61,409.61)

"BLD",11220,"KRN","B",771,771)

"BLD",11220,"KRN","B",779.2,779.2)

"BLD",11220,"KRN","B",870,870)

"BLD",11220,"KRN","B",8989.51,8989.51)

"BLD",11220,"KRN","B",8989.52,8989.52)

"BLD",11220,"KRN","B",8994,8994)

"BLD",11220,"QUES",0)
^9.62^^
"BLD",11220,"REQB",0)
^9.611^1^1
"BLD",11220,"REQB",1,0)
IB*2.0*621^1
"BLD",11220,"REQB","B","IB*2.0*621",1)

"FIA",355.36)
CREATION TO PROCESSING TRACKING
"FIA",355.36,0)
^IBA(355.36,
"FIA",355.36,0,0)
355.36D
"FIA",355.36,0,1)
y^n^f^^^^n
"FIA",355.36,0,10)

"FIA",355.36,0,11)

"FIA",355.36,0,"RLRO")

"FIA",355.36,0,"VR")
2.0^IB
"FIA",355.36,355.36)
0
"FIA",365.1)
IIV TRANSMISSION QUEUE
"FIA",365.1,0)
^IBCN(365.1,
"FIA",365.1,0,0)
365.1
"FIA",365.1,0,1)
y^n^p^^^^n^^n
"FIA",365.1,0,10)

"FIA",365.1,0,11)

"FIA",365.1,0,"RLRO")

"FIA",365.1,0,"VR")
2.0^IB
"FIA",365.1,365.1)
1
"FIA",365.1,365.1,.1)

"INIT")
POST^IBY631PO
"MBREQ")
0
"PKG",230,-1)
1^1
"PKG",230,0)
INTEGRATED BILLING^IB^INTEGRATED BILLING
"PKG",230,22,0)
^9.49I^1^1
"PKG",230,22,1,0)
2.0^2940321^2940525
"PKG",230,22,1,"PAH",1,0)
631^3190612
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
14
"RTN","IBCEOB01")
0^1^B26160583^B25712240
"RTN","IBCEOB01",1,0)
IBCEOB01 ;ALB/ESG - 835 EDI EOB MSG PROCESSING CONT ;16-JAN-2008
"RTN","IBCEOB01",2,0)
;;2.0;INTEGRATED BILLING;**377,516,631**;21-MAR-94;Build 11
"RTN","IBCEOB01",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCEOB01",4,0)
;
"RTN","IBCEOB01",5,0)
Q
"RTN","IBCEOB01",6,0)
;
"RTN","IBCEOB01",7,0)
; This routine processes the "06" record on the incoming 835 and
"RTN","IBCEOB01",8,0)
; updates the patient insurance files with the corrected name and/or
"RTN","IBCEOB01",9,0)
; subscriber ID# data.
"RTN","IBCEOB01",10,0)
;
"RTN","IBCEOB01",11,0)
UPD(IB0,IBEOB,IBIFN,DFN,SEQ) ; update pat ins policy data
"RTN","IBCEOB01",12,0)
; IB0 - This is the full "06" record data
"RTN","IBCEOB01",13,0)
; IBEOB - ien# to file 361.1
"RTN","IBCEOB01",14,0)
; IBIFN - ien# to file 399
"RTN","IBCEOB01",15,0)
; DFN - patient ien# to file 2
"RTN","IBCEOB01",16,0)
; SEQ - payer sequence number
"RTN","IBCEOB01",17,0)
;
"RTN","IBCEOB01",18,0)
NEW CORRID,IBIT,IBZ,IBZ1,IDCHG,INS,MAX,NAMECHG,NNM,NNM1,PD,POL,X,MCRSFX,MCRLEN,LN
"RTN","IBCEOB01",19,0)
;
"RTN","IBCEOB01",20,0)
; patient ID# processing
"RTN","IBCEOB01",21,0)
S IDCHG=0 ; flag indicating an ID# change
"RTN","IBCEOB01",22,0)
S CORRID=$P(IB0,U,6) ; corrected patient ID#
"RTN","IBCEOB01",23,0)
S CORRID=$TR(CORRID,"-","")
"RTN","IBCEOB01",24,0)
I CORRID'="" D
"RTN","IBCEOB01",25,0)
. I $$VALHIC^IBCNSMM(CORRID) S IDCHG=1 ; valid HIC#
"RTN","IBCEOB01",26,0)
. E D MSG^IBCEOB(IBEOB,"The corrected ID# "_CORRID_" is not a valid Medicare HIC#. No ID# correction done.")
"RTN","IBCEOB01",27,0)
. Q
"RTN","IBCEOB01",28,0)
;
"RTN","IBCEOB01",29,0)
; corrected name processing
"RTN","IBCEOB01",30,0)
S NAMECHG=0 ; flag indicating a name change
"RTN","IBCEOB01",31,0)
I $P(IB0,U,3)="",$P(IB0,U,4)="",$P(IB0,U,5)="" G UPD1 ; no corrected name components indicated
"RTN","IBCEOB01",32,0)
;
"RTN","IBCEOB01",33,0)
D F^IBCEF("N-CURR INSURED FULL NAME","IBZ",,IBIFN) ; get the existing name in standard format (see CI2-2.9)
"RTN","IBCEOB01",34,0)
I IBZ="" D MSG^IBCEOB(IBEOB,"Unable to determine the existing subscriber name.") G UPD1
"RTN","IBCEOB01",35,0)
S IBZ1=$$NAME^IBCEFG1(IBZ) ; parse existing name into component pieces (see CI2-2.9)
"RTN","IBCEOB01",36,0)
;
"RTN","IBCEOB01",37,0)
; Determine if Medicare sent the suffix in the last name field
"RTN","IBCEOB01",38,0)
S MCRSFX="" ; default Medicare suffix found in last name
"RTN","IBCEOB01",39,0)
S LN=$P(IB0,U,3) ; last name
"RTN","IBCEOB01",40,0)
S MCRLEN=$L(LN," ") ; how many " " pieces there are in the Medicare last name
"RTN","IBCEOB01",41,0)
I MCRLEN>1 D
"RTN","IBCEOB01",42,0)
. S MCRSFX=$$CHKSUF($P(LN," ",MCRLEN)) ; check the last piece to see if it is a common suffix
"RTN","IBCEOB01",43,0)
. Q
"RTN","IBCEOB01",44,0)
;
"RTN","IBCEOB01",45,0)
; build new name components
"RTN","IBCEOB01",46,0)
S NNM("FAMILY")=$S($P(IB0,U,3)'="":$P(IB0,U,3),1:$P(IBZ1,U,1))
"RTN","IBCEOB01",47,0)
S NNM("GIVEN")=$S($P(IB0,U,4)'="":$P(IB0,U,4),1:$P(IBZ1,U,2))
"RTN","IBCEOB01",48,0)
S NNM("MIDDLE")=$S($P(IB0,U,5)'="":$P(IB0,U,5),1:$P(IBZ1,U,3))
"RTN","IBCEOB01",49,0)
S NNM("SUFFIX")=$S(MCRSFX'="":"",1:$P(IBZ1,U,5)) ; if suffix is in the Medicare last name, blank it out here
"RTN","IBCEOB01",50,0)
;
"RTN","IBCEOB01",51,0)
I NNM("FAMILY")="" D MSG^IBCEOB(IBEOB,"Last name is nil.") G UPD1
"RTN","IBCEOB01",52,0)
I NNM("GIVEN")="" D MSG^IBCEOB(IBEOB,"First name is nil.") G UPD1
"RTN","IBCEOB01",53,0)
;
"RTN","IBCEOB01",54,0)
K MAX D FIELD^DID(2.312,17,,"FIELD LENGTH","MAX") S MAX=$G(MAX("FIELD LENGTH"))
"RTN","IBCEOB01",55,0)
I 'MAX D MSG^IBCEOB(IBEOB,"Unable to determine the maximum field length for 2.312,17.") G UPD1
"RTN","IBCEOB01",56,0)
S NNM1=$$NAMEFMT^XLFNAME(.NNM,"F","CL"_MAX) ; construct the new name
"RTN","IBCEOB01",57,0)
K IBIT D FIELD^DID(2.312,17,,"INPUT TRANSFORM","IBIT") S IBIT=$G(IBIT("INPUT TRANSFORM"))
"RTN","IBCEOB01",58,0)
S X=NNM1 X IBIT ; invoke the input transform on the field to see if it is valid
"RTN","IBCEOB01",59,0)
I '$D(X) D MSG^IBCEOB(IBEOB,"New name '"_NNM1_"' failed the input transform for field 2.312,17.") G UPD1
"RTN","IBCEOB01",60,0)
;
"RTN","IBCEOB01",61,0)
; at this point, all name checks have passed and we have a valid, new, corrected name in NNM1
"RTN","IBCEOB01",62,0)
S NAMECHG=1
"RTN","IBCEOB01",63,0)
;
"RTN","IBCEOB01",64,0)
UPD1 ;
"RTN","IBCEOB01",65,0)
;
"RTN","IBCEOB01",66,0)
I 'NAMECHG,'IDCHG D MSG^IBCEOB(IBEOB,"No changes made.") G UPDX
"RTN","IBCEOB01",67,0)
;
"RTN","IBCEOB01",68,0)
I NAMECHG D
"RTN","IBCEOB01",69,0)
. N DIE,DA,DR
"RTN","IBCEOB01",70,0)
. D MSG^IBCEOB(IBEOB,"Name corrected from "_IBZ_" to "_NNM1_".")
"RTN","IBCEOB01",71,0)
. S DIE=361.1,DA=IBEOB,DR="6.01////^S X=NNM1" D ^DIE
"RTN","IBCEOB01",72,0)
. Q
"RTN","IBCEOB01",73,0)
;
"RTN","IBCEOB01",74,0)
I IDCHG D
"RTN","IBCEOB01",75,0)
. N DIE,DA,DR
"RTN","IBCEOB01",76,0)
. D MSG^IBCEOB(IBEOB,"ID# corrected from "_$$POLICY^IBCEF(IBIFN,2,SEQ)_" to "_CORRID_".")
"RTN","IBCEOB01",77,0)
. S DIE=361.1,DA=IBEOB,DR="6.02////^S X=CORRID" D ^DIE
"RTN","IBCEOB01",78,0)
. Q
"RTN","IBCEOB01",79,0)
;
"RTN","IBCEOB01",80,0)
; Loop thru patient policies looking to update all Medicare entries
"RTN","IBCEOB01",81,0)
S POL=0
"RTN","IBCEOB01",82,0)
F S POL=$O(^DPT(DFN,.312,POL)) Q:'POL D
"RTN","IBCEOB01",83,0)
. ;S PD=$G(^DPT(DFN,.312,POL,0)) ; policy data on the 0 node ;516 - baa
"RTN","IBCEOB01",84,0)
. S PD=$$ZND^IBCNS1(DFN,POL) ; policy data on the 0 node ;516 - baa
"RTN","IBCEOB01",85,0)
. S INS=+PD
"RTN","IBCEOB01",86,0)
. I '$$MCRWNR^IBEFUNC(INS) Q ; quit if ins co isn't Medicare
"RTN","IBCEOB01",87,0)
. I IDCHG,CORRID'=$P(PD,U,2) D UPDID(DFN,POL,CORRID) ; ID# change
"RTN","IBCEOB01",88,0)
. I NAMECHG,NNM1'=$P(PD,U,17) D UPDNM(DFN,POL,NNM1) ; name change
"RTN","IBCEOB01",89,0)
. Q
"RTN","IBCEOB01",90,0)
UPDX ;
"RTN","IBCEOB01",91,0)
Q
"RTN","IBCEOB01",92,0)
;
"RTN","IBCEOB01",93,0)
UPDID(DFN,DA,ID) ; update the subscriber ID# field
"RTN","IBCEOB01",94,0)
N DR,DIE,DIC
"RTN","IBCEOB01",95,0)
S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
"RTN","IBCEOB01",96,0)
S DR="7.02///^S X=ID" ;patch 516 - baa changes
"RTN","IBCEOB01",97,0)
D ^DIE
"RTN","IBCEOB01",98,0)
D UPDAUD(DFN,DA) ; audit info
"RTN","IBCEOB01",99,0)
Q
"RTN","IBCEOB01",100,0)
;
"RTN","IBCEOB01",101,0)
UPDNM(DFN,DA,NM) ; update the subscriber name field
"RTN","IBCEOB01",102,0)
N DR,DIE,DIC
"RTN","IBCEOB01",103,0)
S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
"RTN","IBCEOB01",104,0)
S DR="7.01///^S X=NM" ;patch 516 - baa changes
"RTN","IBCEOB01",105,0)
D ^DIE
"RTN","IBCEOB01",106,0)
D UPDAUD(DFN,DA) ; audit info
"RTN","IBCEOB01",107,0)
Q
"RTN","IBCEOB01",108,0)
;
"RTN","IBCEOB01",109,0)
UPDAUD(DFN,DA) ; update the audit information for this patient insurance policy
"RTN","IBCEOB01",110,0)
N DR,DIE,DIC
"RTN","IBCEOB01",111,0)
D UPDATPT^IBCNSP3(DFN,DA) ; date and time last edited and by whom
"RTN","IBCEOB01",112,0)
; Check for SOI being populated in (#2.312,1.09) before setting it.
"RTN","IBCEOB01",113,0)
;IB*2.0*631/TAZ - Changed logic to only update to Medicare if no other SOI exists.
"RTN","IBCEOB01",114,0)
I $$GET1^DIQ(2.312,DA_","_DFN_",",1.09)="" D
"RTN","IBCEOB01",115,0)
. S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
"RTN","IBCEOB01",116,0)
. S DR="1.09///MEDICARE" ; source of information is MEDICARE
"RTN","IBCEOB01",117,0)
. D ^DIE
"RTN","IBCEOB01",118,0)
D UPDCLM^IBCNSP1(DFN,DA) ; update editable claims
"RTN","IBCEOB01",119,0)
Q
"RTN","IBCEOB01",120,0)
;
"RTN","IBCEOB01",121,0)
CHKSUF(X) ; Return X if it looks like a suffix; otherwise, return null
"RTN","IBCEOB01",122,0)
Q:"^I^II^III^IV^V^VI^VII^VIII^IX^X^JR^SR^DR^MD^ESQ^DDS^RN^"[(U_X_U) X
"RTN","IBCEOB01",123,0)
Q:"^1ST^2ND^3RD^4TH^5TH^6TH^7TH^8TH^9TH^10TH^"[(U_X_U) X
"RTN","IBCEOB01",124,0)
Q ""
"RTN","IBCEOB01",125,0)
;
"RTN","IBCNBLL")
0^13^B178996455^B157960738
"RTN","IBCNBLL",1,0)
IBCNBLL ;ALB/ARH - Ins Buffer: LM main screen, list buffer entries ;1 Jun 97
"RTN","IBCNBLL",2,0)
;;2.0;INTEGRATED BILLING;**82,149,153,183,184,271,345,416,438,435,506,519,528,549,601,595,631**;21-MAR-94;Build 11
"RTN","IBCNBLL",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNBLL",4,0)
;
"RTN","IBCNBLL",5,0)
; DBIA# 642 for call to $$LST^DGMTU
"RTN","IBCNBLL",6,0)
; DBIA# 4433 for call to $$SDAPI^SDAMA301
"RTN","IBCNBLL",7,0)
;
"RTN","IBCNBLL",8,0)
EN ; - main entry point for screen
"RTN","IBCNBLL",9,0)
N VIEW,AVIEW,DFLG,IBKEYS
"RTN","IBCNBLL",10,0)
S VIEW=6,AVIEW=0 ; default to complete view ;IB*2*506/taz changed
"RTN","IBCNBLL",11,0)
K ^TMP("IBCNERTQ",$J) ; clear temp. global for eIV real time inquiries
"RTN","IBCNBLL",12,0)
D EN^VALM("IBCNB INSURANCE BUFFER LIST")
"RTN","IBCNBLL",13,0)
Q
"RTN","IBCNBLL",14,0)
;
"RTN","IBCNBLL",15,0)
EN1(V) ; entry point from view changing actions
"RTN","IBCNBLL",16,0)
S VIEW=V S AVIEW=$S(VIEW=4:1,1:0)
"RTN","IBCNBLL",17,0)
D INIT,HDR
"RTN","IBCNBLL",18,0)
S VALMBCK="R",VALMBG=1
"RTN","IBCNBLL",19,0)
Q
"RTN","IBCNBLL",20,0)
;
"RTN","IBCNBLL",21,0)
HDR ; header code for list manager display
"RTN","IBCNBLL",22,0)
S VALMHDR(1)="Sorted by: "_$P(IBCNSORT,U,2)
"RTN","IBCNBLL",23,0)
I $P(IBCNSORT,U,3)'="" S VALMHDR(1)=VALMHDR(1)_", """_$P(IBCNSORT,U,3)_""" first"
"RTN","IBCNBLL",24,0)
I VIEW=1 S VALM("TITLE")="Positive Insurance Buffer",VALMSG="*Verified +Active" ;IB*2*506/taz Only shows Verified and Active records.
"RTN","IBCNBLL",25,0)
I VIEW=2 S VALM("TITLE")="Negative Insurance Buffer",VALMSG="*Verified -N/Active" ;IB*2*506/taz Only shows Verified and N/Active records.
"RTN","IBCNBLL",26,0)
I VIEW=3 S VALM("TITLE")="Medicare(WNR) Insurance Buffer",VALMSG="*Verified +Act -N/Act ?Await/R #Unclr !Unable/Send"
"RTN","IBCNBLL",27,0)
I VIEW=4 S VALM("TITLE")="Failure Buffer",VALMSG="!Unable/Send" ;IB*2*506/taz changed
"RTN","IBCNBLL",28,0)
I VIEW=5 S VALM("TITLE")="e-Pharmacy Buffer",VALMSG="*Verified" ; IB*2*435
"RTN","IBCNBLL",29,0)
I VIEW=6 S VALM("TITLE")="Complete Buffer",VALMSG="" ; IB*2*506/taz added
"RTN","IBCNBLL",30,0)
I VIEW=7 S VALM("TITLE")="TRICARE/CHAMPVA",VALMSG="" ;528/baa added
"RTN","IBCNBLL",31,0)
Q
"RTN","IBCNBLL",32,0)
;
"RTN","IBCNBLL",33,0)
INIT ; initialization for list manager list
"RTN","IBCNBLL",34,0)
K ^TMP("IBCNBLL",$J),^TMP("IBCNBLLX",$J),^TMP("IBCNBLLY",$J),^TMP($J,"IBCNBLLS"),^TMP($J,"IBCNAPPTS")
"RTN","IBCNBLL",35,0)
S:$G(IBCNSORT)="" IBCNSORT=$S(VIEW=1:"10^Positive Response",1:"1^Patient Name")
"RTN","IBCNBLL",36,0)
S IBKEYS=$$GETKEYS(DUZ) ;IB*2*506/taz user must have either IB INSURANCE EDIT or IB GROUP/PLAN EDIT in order to view entries without defined insurance company entries
"RTN","IBCNBLL",37,0)
D BLD
"RTN","IBCNBLL",38,0)
Q
"RTN","IBCNBLL",39,0)
;
"RTN","IBCNBLL",40,0)
HELP ; list manager help
"RTN","IBCNBLL",41,0)
D FULL^VALM1
"RTN","IBCNBLL",42,0)
S VALMBCK="R"
"RTN","IBCNBLL",43,0)
W @IOF
"RTN","IBCNBLL",44,0)
W !,"Flags displayed on screen if they apply to the Buffer entry:"
"RTN","IBCNBLL",45,0)
W !," i - Patient has other currently effective Insurance"
"RTN","IBCNBLL",46,0)
W !," I - Patient is currently admitted as an Inpatient"
"RTN","IBCNBLL",47,0)
W !," E - Patient has Expired"
"RTN","IBCNBLL",48,0)
W !," Y - Means Test Copay Patient"
"RTN","IBCNBLL",49,0)
W !," H - Patient has Bills On Hold"
"RTN","IBCNBLL",50,0)
W !," * - Buffer entry Verified by User"
"RTN","IBCNBLL",51,0)
W !
"RTN","IBCNBLL",52,0)
D PAUSE^VALM1 I 'Y Q
"RTN","IBCNBLL",53,0)
W !,"Sources displayed on the screen if they apply to the Buffer entry:"
"RTN","IBCNBLL",54,0)
W !," I - Interview"
"RTN","IBCNBLL",55,0)
W !," D - Data Match"
"RTN","IBCNBLL",56,0)
W !," V - IVM"
"RTN","IBCNBLL",57,0)
W !," P - Pre-Registration"
"RTN","IBCNBLL",58,0)
W !," E - eIV"
"RTN","IBCNBLL",59,0)
W !," H - HMS"
"RTN","IBCNBLL",60,0)
W !," M - Medicare"
"RTN","IBCNBLL",61,0)
W !," R - ICB Card Reader"
"RTN","IBCNBLL",62,0)
W !," C - Contract Services"
"RTN","IBCNBLL",63,0)
W !," X - e-Pharmacy" ; IB*2*435
"RTN","IBCNBLL",64,0)
; IB*2*595/DM K,T,U,B,O,N,S,A,J added
"RTN","IBCNBLL",65,0)
W !," K - Kiosk"
"RTN","IBCNBLL",66,0)
W !," F - Interfacility Insurance Update" ; IB*2*528
"RTN","IBCNBLL",67,0)
W !," T - Insurance Import"
"RTN","IBCNBLL",68,0)
W !," U - Purchased Care Choice"
"RTN","IBCNBLL",69,0)
W !," B - Purchased Care Fee-Basis"
"RTN","IBCNBLL",70,0)
W !," O - Purchased Care Other"
"RTN","IBCNBLL",71,0)
W !," N - Insurance Intake"
"RTN","IBCNBLL",72,0)
W !," S - Insurance Verification"
"RTN","IBCNBLL",73,0)
W !," A - Veteran Appt Request"
"RTN","IBCNBLL",74,0)
W !," J - MYVA Health Journal"
"RTN","IBCNBLL",75,0)
D PAUSE^VALM1 I 'Y Q
"RTN","IBCNBLL",76,0)
;
"RTN","IBCNBLL",77,0)
I VIEW'=5 D ; IB*2*435
"RTN","IBCNBLL",78,0)
. W !,"eIV Electronic Insurance Verification Status"
"RTN","IBCNBLL",79,0)
. W !!,"The following eIV Status indicators may appear to the left of the patient name:",!
"RTN","IBCNBLL",80,0)
. Q
"RTN","IBCNBLL",81,0)
;
"RTN","IBCNBLL",82,0)
I VIEW=1 D
"RTN","IBCNBLL",83,0)
.W !," + - eIV payer response indicates this is an active policy."
"RTN","IBCNBLL",84,0)
.W !," $ - Escalated active policy."
"RTN","IBCNBLL",85,0)
.W !," * - Previously an active policy."
"RTN","IBCNBLL",86,0)
.Q
"RTN","IBCNBLL",87,0)
I VIEW=2 D
"RTN","IBCNBLL",88,0)
.W !," - - eIV payer response indicates this is NOT an active policy."
"RTN","IBCNBLL",89,0)
.W !," * - Previously an not active policy."
"RTN","IBCNBLL",90,0)
.Q
"RTN","IBCNBLL",91,0)
I $F(",3,6,7,",VIEW) D ;528/baa
"RTN","IBCNBLL",92,0)
.W !," + - eIV payer response indicates this is an active policy."
"RTN","IBCNBLL",93,0)
.W !," ? - Awaiting electronic reply from eIV Payer."
"RTN","IBCNBLL",94,0)
.W !," $ - Escalated Active policy."
"RTN","IBCNBLL",95,0)
.W !," * - Previously either an active or not active policy."
"RTN","IBCNBLL",96,0)
.W !," # - Can not determine from eIV response if coverage is Active."
"RTN","IBCNBLL",97,0)
.W !," Review Response Report. Manual verification required."
"RTN","IBCNBLL",98,0)
.W !," ! - eIV was unable to send an inquiry for this entry."
"RTN","IBCNBLL",99,0)
.W !," Corrections required or payer not Active."
"RTN","IBCNBLL",100,0)
.W !," - - eIV payer response indicates this is NOT an active policy."
"RTN","IBCNBLL",101,0)
.W !," % - CMS responded with the patient's new MBI value."
"RTN","IBCNBLL",102,0)
.W !,"<Blank> - Entry added through manual process."
"RTN","IBCNBLL",103,0)
.Q
"RTN","IBCNBLL",104,0)
I VIEW=4 D
"RTN","IBCNBLL",105,0)
.W !," ! - eIV was unable to send an inquiry for this entry."
"RTN","IBCNBLL",106,0)
.W !," Corrections required or payer not Active."
"RTN","IBCNBLL",107,0)
.Q
"RTN","IBCNBLL",108,0)
;
"RTN","IBCNBLL",109,0)
I VIEW=5 D ; IB*2*435
"RTN","IBCNBLL",110,0)
. W !," e-Pharmacy buffer entries are not applicable for e-IV processing."
"RTN","IBCNBLL",111,0)
. Q
"RTN","IBCNBLL",112,0)
;
"RTN","IBCNBLL",113,0)
D PAUSE^VALM1 I 'Y Q
"RTN","IBCNBLL",114,0)
W !,"When an entry is Processed it is either:"
"RTN","IBCNBLL",115,0)
W !," Accepted - the Buffer entry's data is stored in the main Insurance files."
"RTN","IBCNBLL",116,0)
W !," - the modified Insurance entry is flagged as Verified."
"RTN","IBCNBLL",117,0)
W !
"RTN","IBCNBLL",118,0)
W !," Rejected - the Buffer entry's data is not stored in the main Insurance files."
"RTN","IBCNBLL",119,0)
W !!
"RTN","IBCNBLL",120,0)
W !,"Once an entry is processed (either accepted or rejected) most of the data in"
"RTN","IBCNBLL",121,0)
W !,"the Buffer File entry is deleted leaving only a stub entry for tracking"
"RTN","IBCNBLL",122,0)
W !,"and reporting purposes."
"RTN","IBCNBLL",123,0)
W !!
"RTN","IBCNBLL",124,0)
W !,"The IB INSURANCE SUPERVISOR key is required to either Accept or Reject an entry."
"RTN","IBCNBLL",125,0)
D PAUSE^VALM1
"RTN","IBCNBLL",126,0)
Q
"RTN","IBCNBLL",127,0)
;
"RTN","IBCNBLL",128,0)
EXIT ; exit list manager option and clean up
"RTN","IBCNBLL",129,0)
K ^TMP("IBCNBLL",$J),^TMP("IBCNBLLX",$J),^TMP("IBCNBLLY",$J),^TMP($J,"IBCNBLLS"),^TMP($J,"SDAMA301"),^TMP($J,"IBCNAPPTS")
"RTN","IBCNBLL",130,0)
K IBCNSORT,IBCNSCRN,DFN,IBINSDA,IBFASTXT,IBBUFDA
"RTN","IBCNBLL",131,0)
D CLEAR^VALM1
"RTN","IBCNBLL",132,0)
Q
"RTN","IBCNBLL",133,0)
;
"RTN","IBCNBLL",134,0)
BLD ; build screen display
"RTN","IBCNBLL",135,0)
N IBCNT,IBCNS1,IBCNS2,IBBUFDA,IBLINE
"RTN","IBCNBLL",136,0)
;
"RTN","IBCNBLL",137,0)
D SORT S IBCNT=0,VALMCNT=0,IBBUFDA=0
"RTN","IBCNBLL",138,0)
;
"RTN","IBCNBLL",139,0)
S IBCNS1="" F S IBCNS1=$O(^TMP($J,"IBCNBLLS",IBCNS1)) Q:IBCNS1="" D
"RTN","IBCNBLL",140,0)
.S IBCNS2="" F S IBCNS2=$O(^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2)) Q:IBCNS2="" D
"RTN","IBCNBLL",141,0)
..S IBBUFDA=0 F S IBBUFDA=$O(^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA)) Q:'IBBUFDA D
"RTN","IBCNBLL",142,0)
...S DFLG=^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA)
"RTN","IBCNBLL",143,0)
...S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#15) W "."
"RTN","IBCNBLL",144,0)
...S IBLINE=$$BLDLN(IBBUFDA,IBCNT,DFLG) I IBLINE="" S IBCNT=IBCNT-1 Q ; IB*2*506/taz If line is null stop processing this entry.
"RTN","IBCNBLL",145,0)
...D SET(IBLINE,IBCNT)
"RTN","IBCNBLL",146,0)
;
"RTN","IBCNBLL",147,0)
I VALMCNT=0 D SET("",0),SET("There are no Buffer entries that have not been processed.",0)
"RTN","IBCNBLL",148,0)
Q
"RTN","IBCNBLL",149,0)
;
"RTN","IBCNBLL",150,0)
BLDLN(IBBUFDA,IBCNT,DFLG) ; build line to display on List screen for one Buffer entry
"RTN","IBCNBLL",151,0)
N DFN,IB0,IB20,IB40,IB60,IBLINE,IBMTS,IBY,MCFLAG,VA,VADM,VAERR,VAIN,X,Y
"RTN","IBCNBLL",152,0)
S IBLINE="",IBBUFDA=+$G(IBBUFDA)
"RTN","IBCNBLL",153,0)
S IB40=$G(^IBA(355.33,IBBUFDA,40)),MCFLAG=$$GTMFLG(IBBUFDA) ;IB*2.0*549
"RTN","IBCNBLL",154,0)
S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB60=$G(^IBA(355.33,IBBUFDA,60))
"RTN","IBCNBLL",155,0)
S DFN=+IB60 I +DFN D DEM^VADPT,INP^VADPT
"RTN","IBCNBLL",156,0)
;
"RTN","IBCNBLL",157,0)
;IB*2.0*549 - Replaced the following line of code:
"RTN","IBCNBLL",158,0)
;I 'IBKEYS,'$$ACTIVE(DFN) G BLDLNQ ;IB*2*506/taz Only allow active insurance for users not holding IB INSURANCE EDIT or IB GROUP/PLAN EDIT keys
"RTN","IBCNBLL",159,0)
; With the following code that will determine if the list item is Medicare (+MCFLAG,) then include it on
"RTN","IBCNBLL",160,0)
; the list even if the user doesn't have the security keys and if the patient has ACTIVE or INACTIVE policies.
"RTN","IBCNBLL",161,0)
I 'IBKEYS,'$$ACTIVE(DFN),'MCFLAG G BLDLNQ ;IB*2.0*549
"RTN","IBCNBLL",162,0)
;
"RTN","IBCNBLL",163,0)
S IBY=$G(IBCNT),IBLINE=$$SETSTR^VALM1(IBY,"",1,4)
"RTN","IBCNBLL",164,0)
;
"RTN","IBCNBLL",165,0)
; ESG - 6/6/02 - SDD 5.1.8
"RTN","IBCNBLL",166,0)
; pull the symbol from the symbol function
"RTN","IBCNBLL",167,0)
;
"RTN","IBCNBLL",168,0)
S IBY=$$SYMBOL(IBBUFDA)
"RTN","IBCNBLL",169,0)
I IBY="*" S IBY=" " ;528/baa
"RTN","IBCNBLL",170,0)
S IBY=IBY_$P($G(^DPT(+DFN,0)),U,1),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,5,20)
"RTN","IBCNBLL",171,0)
S IBLINE=$$SETSTR^VALM1(DFLG,IBLINE,25,1)
"RTN","IBCNBLL",172,0)
S IBY=$G(VA("BID")),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,27,4)
"RTN","IBCNBLL",173,0)
S IBY=$P(IB20,U,1),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,32,17)
"RTN","IBCNBLL",174,0)
S IBY=$P(IB60,U,4),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,50,13)
"RTN","IBCNBLL",175,0)
S IBY=$$GET1^DIQ(355.12,$P(IB0,U,3),.03),IBLINE=$$SETSTR^VALM1($$SRCCNV(IBY),IBLINE,64,1)
"RTN","IBCNBLL",176,0)
S IBY=$$DATE(+IB0),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,66,8)
"RTN","IBCNBLL",177,0)
S IBY="" D S IBLINE=$$SETSTR^VALM1(IBY,IBLINE,76,5)
"RTN","IBCNBLL",178,0)
. S IBY=IBY_$S(+$$INSURED^IBCNS1(DFN,DT):"i",1:" ")
"RTN","IBCNBLL",179,0)
. S IBY=IBY_$S(+$G(VAIN(1)):"I",1:" ")
"RTN","IBCNBLL",180,0)
. S IBY=IBY_$S(+$G(VADM(6)):"E",1:" ")
"RTN","IBCNBLL",181,0)
. S IBMTS=$P($$LST^DGMTU(DFN),U,4)
"RTN","IBCNBLL",182,0)
. S IBY=IBY_$S(IBMTS="C":"Y",IBMTS="G":"Y",1:" ")
"RTN","IBCNBLL",183,0)
. S IBY=IBY_$S(+$$HOLD(DFN):"H",1:" ")
"RTN","IBCNBLL",184,0)
BLDLNQ ; IB*2*506/taz Tag added
"RTN","IBCNBLL",185,0)
Q IBLINE
"RTN","IBCNBLL",186,0)
;
"RTN","IBCNBLL",187,0)
SET(LINE,CNT) ; set up list manager screen display array
"RTN","IBCNBLL",188,0)
S VALMCNT=VALMCNT+1
"RTN","IBCNBLL",189,0)
S ^TMP("IBCNBLL",$J,VALMCNT,0)=LINE Q:'CNT
"RTN","IBCNBLL",190,0)
S ^TMP("IBCNBLL",$J,"IDX",VALMCNT,+CNT)=""
"RTN","IBCNBLL",191,0)
S ^TMP("IBCNBLLX",$J,CNT)=VALMCNT_U_IBBUFDA
"RTN","IBCNBLL",192,0)
S ^TMP("IBCNBLLY",$J,IBBUFDA)=VALMCNT_U_+CNT
"RTN","IBCNBLL",193,0)
Q
"RTN","IBCNBLL",194,0)
;
"RTN","IBCNBLL",195,0)
SORT ; set up sort for list screen
"RTN","IBCNBLL",196,0)
; 1^Patient Name, 2^Ins Name, 3^Source Of Info, 4^Date Entered, 5^Inpatient (Y/N), 6^Means Test (Y/N), 7^On Hold, 8^Verified, 9^eIV Status, 10^Positive Response
"RTN","IBCNBLL",197,0)
N APPTNUM,IB0,IB20,IB60,IBCNDT,IBBUFDA,IBCNDFN,IBCNPAT,IBCSORT1,IBCSORT2,IBSDA,DFN,VAIN,VA,VAERR,IBX,IBCNT,INAME,SYM,X,Y
"RTN","IBCNBLL",198,0)
S IBCNT=0
"RTN","IBCNBLL",199,0)
;
"RTN","IBCNBLL",200,0)
K ^TMP($J,"IBCNBLLS") I '$G(IBCNSORT) S IBCNSORT="1^Patient Name"
"RTN","IBCNBLL",201,0)
; get payer ien for Medicare WNR
"RTN","IBCNBLL",202,0)
;
"RTN","IBCNBLL",203,0)
S IBCNDT=0 F S IBCNDT=$O(^IBA(355.33,"AEST","E",IBCNDT)) Q:'IBCNDT D
"RTN","IBCNBLL",204,0)
.S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AEST","E",IBCNDT,IBBUFDA)) Q:'IBBUFDA D
"RTN","IBCNBLL",205,0)
..S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#15) W "."
"RTN","IBCNBLL",206,0)
..S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB60=$G(^IBA(355.33,IBBUFDA,60))
"RTN","IBCNBLL",207,0)
..S IBCNDFN=+IB60,IBCNPAT="" I +IBCNDFN S IBCNPAT=$P($G(^DPT(IBCNDFN,0)),U,1)
"RTN","IBCNBLL",208,0)
..S INAME=$P(IB20,U)
"RTN","IBCNBLL",209,0)
..;
"RTN","IBCNBLL",210,0)
..I +IBCNSORT=1 S IBCSORT1=IBCNPAT
"RTN","IBCNBLL",211,0)
..I +IBCNSORT=2 S IBCSORT1=INAME
"RTN","IBCNBLL",212,0)
..I +IBCNSORT=3 S IBCSORT1=$P(IB0,U,3)
"RTN","IBCNBLL",213,0)
..I +IBCNSORT=4 S IBCSORT1=$P(+IB0,".",1)
"RTN","IBCNBLL",214,0)
..I +IBCNSORT=5 I +IBCNDFN S DFN=+IBCNDFN D INP^VADPT S IBCSORT1=$S($G(VAIN(1)):1,1:2)
"RTN","IBCNBLL",215,0)
..I +IBCNSORT=6 I +IBCNDFN S IBX=$P($$LST^DGMTU(IBCNDFN),U,4) S IBCSORT1=$S(IBX="C":1,IBX="G":1,1:2)
"RTN","IBCNBLL",216,0)
..I +IBCNSORT=7 I +IBCNDFN S IBX=$$HOLD(IBCNDFN) S IBCSORT1=$S(+IBX:1,1:2)
"RTN","IBCNBLL",217,0)
..I +IBCNSORT=8 S IBCSORT1=$S(+$P(IB0,U,10):1,1:2)
"RTN","IBCNBLL",218,0)
..; Sort by symbol and then within the symbol, sort by date entered
"RTN","IBCNBLL",219,0)
..; Build a numerical subscript with format ##.FM date
"RTN","IBCNBLL",220,0)
..S SYM=$$SYMBOL(IBBUFDA)
"RTN","IBCNBLL",221,0)
..I +IBCNSORT=9 S IBCSORT1=$G(IBCNSORT(1,SYM))_"."_$P(+IB0,".",1),IBCSORT1=+IBCSORT1
"RTN","IBCNBLL",222,0)
..;
"RTN","IBCNBLL",223,0)
..I +IBCNSORT=10 S IBCSORT1=$S(SYM="+":0,1:1),IBCSORT2=IBCNPAT
"RTN","IBCNBLL",224,0)
..;
"RTN","IBCNBLL",225,0)
..S IBCSORT1=$S($G(IBCSORT1)="":"~UNKNOWN",1:IBCSORT1),IBCSORT2=$S(IBCNPAT="":"~UNKNOWN",1:IBCNPAT)
"RTN","IBCNBLL",226,0)
..; get future appointments
"RTN","IBCNBLL",227,0)
..S IBSDA(1)=DT,IBSDA(3)="R;I;NT",IBSDA(4)=IBCNDFN,IBSDA("FLDS")="1;2"
"RTN","IBCNBLL",228,0)
..S DFLG="" ;,APPTNUM=$$SDAPI^SDAMA301(.IBSDA) I APPTNUM>0,SYM="!" S DFLG="d" ; duplicate flag ;IB*2*506 appointment data removed.
"RTN","IBCNBLL",229,0)
..I $$INCL(VIEW,SYM,IB0) S ^TMP($J,"IBCNBLLS",IBCSORT1,IBCSORT2,IBBUFDA)=DFLG
"RTN","IBCNBLL",230,0)
..K VAIN,IBCSORT1,IBCSORT2
"RTN","IBCNBLL",231,0)
..Q
"RTN","IBCNBLL",232,0)
.Q
"RTN","IBCNBLL",233,0)
I IBCNT,'$D(ZTQUEUED) W "|"
"RTN","IBCNBLL",234,0)
Q
"RTN","IBCNBLL",235,0)
;
"RTN","IBCNBLL",236,0)
INCL(VIEW,SYM,IB0) ;
"RTN","IBCNBLL",237,0)
N INCL,IENS,IBEBI,MCFLAG
"RTN","IBCNBLL",238,0)
S INCL=0
"RTN","IBCNBLL",239,0)
; IB*2*549 - Added 'MCFLAG to allow Medicare in the following line.
"RTN","IBCNBLL",240,0)
S MCFLAG=$$GTMFLG(IBBUFDA)
"RTN","IBCNBLL",241,0)
I 'IBKEYS,'MCFLAG,(SYM'="+") G INCLQ ; If users don't have required keys, they only see current Positive Entries.
"RTN","IBCNBLL",242,0)
I VIEW=6 S INCL=1 G INCLQ ;Include Everything (Complete view)
"RTN","IBCNBLL",243,0)
I VIEW=7,((INAME["TRICARE")!(INAME["CHAMPVA")) S INCL=1 G INCLQ ; Tricare/Champva;528/baa
"RTN","IBCNBLL",244,0)
I VIEW=5,$P(IB0,U,17) S INCL=1 G INCLQ ;Only e-Pharmacy on e-Pharmacy view (IB*2*435)
"RTN","IBCNBLL",245,0)
I $P(IB0,U,17) G INCLQ ;Exclude e-Pharmacy (IB*2*435)
"RTN","IBCNBLL",246,0)
I VIEW=3,MCFLAG S INCL=1 G INCLQ ;Only Medicare View
"RTN","IBCNBLL",247,0)
I MCFLAG G INCLQ ;Exclude Medicare from Positive, Negative and Failure Views
"RTN","IBCNBLL",248,0)
I VIEW=4,(SYM="!") S INCL=1 G INCLQ ;Only failures on Failure view
"RTN","IBCNBLL",249,0)
I VIEW=1,((SYM="+")!(SYM="$")) S INCL=1 G INCLQ ;Positive View
"RTN","IBCNBLL",250,0)
I VIEW=2,(SYM="-") S INCL=1 G INCLQ ;Negative View
"RTN","IBCNBLL",251,0)
I SYM="*" D G INCLQ
"RTN","IBCNBLL",252,0)
. ;find history in Response file for verified entries.
"RTN","IBCNBLL",253,0)
. I $$GET1^DIQ(355.33,IBBUFDA,.15)="" S:(VIEW=1) INCL=1 Q ;IIV PROCESSED DATE field is empty entry is positive
"RTN","IBCNBLL",254,0)
. S IENS="1,"_$O(^IBCN(365,"AF",IBBUFDA,""))_","
"RTN","IBCNBLL",255,0)
. ;the following line of code is necessary to check for both "eIV Eligibility Determination" and "IIV Eligibility Determination" (IB*2.0*506)
"RTN","IBCNBLL",256,0)
. I $$GET1^DIQ(365.02,IENS,.06)["IV Eligibility Determination" Q
"RTN","IBCNBLL",257,0)
. S IBEBI=$$GET1^DIQ(365.02,IENS,.02) ;Eligibility/Benefits Info
"RTN","IBCNBLL",258,0)
. I IBEBI=1 S:(VIEW=1) INCL=1 Q
"RTN","IBCNBLL",259,0)
. I VIEW=2 S INCL=1 Q
"RTN","IBCNBLL",260,0)
INCLQ ;
"RTN","IBCNBLL",261,0)
Q INCL
"RTN","IBCNBLL",262,0)
;
"RTN","IBCNBLL",263,0)
DATE(X) ;
"RTN","IBCNBLL",264,0)
Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
"RTN","IBCNBLL",265,0)
HOLD(DFN) ; returns true if patient has bills On Hold
"RTN","IBCNBLL",266,0)
Q $D(^IB("AH",+$G(DFN)))
"RTN","IBCNBLL",267,0)
;
"RTN","IBCNBLL",268,0)
SYMBOL(IBBUFDA) ; Returns the symbol for this buffer entry
"RTN","IBCNBLL",269,0)
NEW IB0,SYM
"RTN","IBCNBLL",270,0)
S IB0=$G(^IBA(355.33,IBBUFDA,0)),SYM=""
"RTN","IBCNBLL",271,0)
I +$P(IB0,U,12) S SYM=$C($P($G(^IBE(365.15,+$P(IB0,U,12),0)),U,2))
"RTN","IBCNBLL",272,0)
; If the entry has been manually verified, override the symbol displayed
"RTN","IBCNBLL",273,0)
I $P(IB0,U,10)'="",'+$P(IB0,U,12) S SYM="*"
"RTN","IBCNBLL",274,0)
I SYM="" S SYM=" "
"RTN","IBCNBLL",275,0)
Q SYM
"RTN","IBCNBLL",276,0)
;
"RTN","IBCNBLL",277,0)
;
"RTN","IBCNBLL",278,0)
UPDLN(IBBUFDA,ACTION) ; *** called by any action that modifies a buffer entry, so list screen can be updated if screen not recompiled
"RTN","IBCNBLL",279,0)
; modifies a single line in the display array for a buffer entry that has been modified in some way
"RTN","IBCNBLL",280,0)
; ACTION = REJECTED, ACCEPTED, EDITED
"RTN","IBCNBLL",281,0)
N IBARRN,IBOLD,IBNEW,IBO,IBN S IBO="0123456789",IBN="----------"
"RTN","IBCNBLL",282,0)
;
"RTN","IBCNBLL",283,0)
S IBARRN=$G(^TMP("IBCNBLLY",$J,+$G(IBBUFDA))) Q:'IBARRN
"RTN","IBCNBLL",284,0)
S IBOLD=$G(^TMP("IBCNBLL",$J,+IBARRN,0)) Q:IBOLD=""
"RTN","IBCNBLL",285,0)
;
"RTN","IBCNBLL",286,0)
; if action is REJECTED or ACCEPTED then the patient name is replaced by the Action in the display array
"RTN","IBCNBLL",287,0)
; and the buffer entry is removed from the list of entries that can be selected
"RTN","IBCNBLL",288,0)
;IB*2.0*631/TAZ Added Tracking for CREATION TO PROCESSING TRACKING File
"RTN","IBCNBLL",289,0)
I (ACTION="REJECTED")!(ACTION="ACCEPTED") D
"RTN","IBCNBLL",290,0)
. D TRACK
"RTN","IBCNBLL",291,0)
. S IBNEW=$TR($E(IBOLD,1,5),IBO,IBN)_ACTION_$J("",7)_$E(IBOLD,21,999)
"RTN","IBCNBLL",292,0)
. S ^TMP("IBCNBLL",$J,+IBARRN,0)=IBNEW
"RTN","IBCNBLL",293,0)
;
"RTN","IBCNBLL",294,0)
; if the action is EDITED then the line for the buffer entry is recompiled and the updated line is set into
"RTN","IBCNBLL",295,0)
; the display array
"RTN","IBCNBLL",296,0)
I ACTION="EDITED" D
"RTN","IBCNBLL",297,0)
. S IBNEW=$$BLDLN(IBBUFDA,+$P(IBARRN,U,2),$E(IBOLD,25))
"RTN","IBCNBLL",298,0)
. S ^TMP("IBCNBLL",$J,+IBARRN,0)=IBNEW
"RTN","IBCNBLL",299,0)
Q
"RTN","IBCNBLL",300,0)
;
"RTN","IBCNBLL",301,0)
SRCCNV(SRC) ; convert Source of Info acronym from field 355.12/.03 into 1 char code
"RTN","IBCNBLL",302,0)
; IB*2*595/DM T,U,B,O,N,S,A,K,J translations added
"RTN","IBCNBLL",303,0)
N SRCSTR,CODE
"RTN","IBCNBLL",304,0)
Q:SRC="" ""
"RTN","IBCNBLL",305,0)
S SRCSTR="INTVW;I^DMTCH;D^IVM;V^PreRg;P^eIV;E^HMS;H^MCR;M^ICB;R^CS;C^eRxEL;X^IIU;F^INSPT;T^CCN;U^PCFB;B^PCOTR;O^INSIN;N^INSVR;S^VAR;A^KSK;K^MVAH;J"
"RTN","IBCNBLL",306,0)
S CODE=$P($P(SRCSTR,SRC_";",2),U,1)
"RTN","IBCNBLL",307,0)
Q CODE
"RTN","IBCNBLL",308,0)
;
"RTN","IBCNBLL",309,0)
;
"RTN","IBCNBLL",310,0)
;
"RTN","IBCNBLL",311,0)
GETKEYS(DUZ) ;
"RTN","IBCNBLL",312,0)
;Make sure that user has the INSURANCE EDIT key and/or the GROUP/PLAN EDIT key. User
"RTN","IBCNBLL",313,0)
;must have either key in order to see non_Positive Entries.
"RTN","IBCNBLL",314,0)
N KEY1,KEY2
"RTN","IBCNBLL",315,0)
S KEY1=$O(^DIC(19.1,"B","IB INSURANCE COMPANY EDIT","")) I KEY1 S KEY1=$D(^VA(200,DUZ,51,KEY1))
"RTN","IBCNBLL",316,0)
S KEY2=$O(^DIC(19.1,"B","IB GROUP PLAN EDIT","")) I KEY2 S KEY2=$D(^VA(200,DUZ,51,KEY2))
"RTN","IBCNBLL",317,0)
Q KEY1!KEY2
"RTN","IBCNBLL",318,0)
;
"RTN","IBCNBLL",319,0)
ACTIVE(DFN) ;Check for active insurance
"RTN","IBCNBLL",320,0)
N IBINSCO
"RTN","IBCNBLL",321,0)
D ALL^IBCNS1(DFN,"IBINSCO",3,DT,0) ;IB*2.0*519 allow WNRs and Indemnity plans
"RTN","IBCNBLL",322,0)
Q +$G(IBINSCO(0))
"RTN","IBCNBLL",323,0)
;
"RTN","IBCNBLL",324,0)
GTMFLG(IBBUFDA) ;Check if Medicare
"RTN","IBCNBLL",325,0)
; IB*2.0*549 Added method
"RTN","IBCNBLL",326,0)
N MWNRIEN,MWNRFLG
"RTN","IBCNBLL",327,0)
S MWNRFLG=0
"RTN","IBCNBLL",328,0)
S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25)
"RTN","IBCNBLL",329,0)
S MWNRFLG=0
"RTN","IBCNBLL",330,0)
I MWNRIEN'="",$P($$INSERROR^IBCNEUT3("B",IBBUFDA),U,2)=MWNRIEN S MWNRFLG=1
"RTN","IBCNBLL",331,0)
Q MWNRFLG
"RTN","IBCNBLL",332,0)
;
"RTN","IBCNBLL",333,0)
;IB*2.0*631/TAZ Added Tracking for CREATION TO PROCESSING TRACKING File
"RTN","IBCNBLL",334,0)
TRACK ;Build CREATION TO PROCESSING TRACKING File (#355.36)
"RTN","IBCNBLL",335,0)
N ERROR,FDA,IBMSG,RESP,TQN,WE
"RTN","IBCNBLL",336,0)
S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) Q:RESP=""
"RTN","IBCNBLL",337,0)
S TQN=$$GET1^DIQ(365,RESP_",",.05,"I")
"RTN","IBCNBLL",338,0)
S WE=$$GET1^DIQ(365.1,TQN_",",.1,"I")
"RTN","IBCNBLL",339,0)
I WE=7 Q ; Do not want to track.
"RTN","IBCNBLL",340,0)
S FDA(355.36,"+1,",.01)=$$NOW^XLFDT ; DATE PROCESSED
"RTN","IBCNBLL",341,0)
S FDA(355.36,"+1,",.02)=$S("^1^2^3^4^"[(U_WE_U):2,"^5^6^"[(U_WE_U):4,1:"")
"RTN","IBCNBLL",342,0)
S FDA(355.36,"+1,",.03)=$$GET1^DIQ(365.1,TQN_",",3.02,"I") ; SOURCE OF INFORMATION
"RTN","IBCNBLL",343,0)
S FDA(355.36,"+1,",.04)=$$GET1^DIQ(365,RESP_",",.13,"I") ; EIV AUTO-UPDATE
"RTN","IBCNBLL",344,0)
S FDA(355.36,"+1,",.05)=TQN ; EIV INQUIRY
"RTN","IBCNBLL",345,0)
S FDA(355.36,"+1,",.06)=RESP ; IV RESPONSE
"RTN","IBCNBLL",346,0)
S FDA(355.36,"+1,",.07)=$G(IBBUFDA) ; BUFFER
"RTN","IBCNBLL",347,0)
S FDA(355.36,"+1,",.08)=WE ; SOURCE OF REQUEST
"RTN","IBCNBLL",348,0)
D UPDATE^DIE("","FDA",,"ERROR")
"RTN","IBCNBLL",349,0)
;
"RTN","IBCNBLL",350,0)
I $D(ERROR) D
"RTN","IBCNBLL",351,0)
. D MSG003^IBCNEMS1(.IBMSG,.ERROR,TQN,RESP,$G(IBBUFDA))
"RTN","IBCNBLL",352,0)
. D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: Error writing to the CREATION TO PROCESSING TRACKING File (#355.36)","IBMSG(")
"RTN","IBCNBLL",353,0)
Q
"RTN","IBCNBLL",354,0)
;
"RTN","IBCNEHL1")
0^10^B212831000^B194684337
"RTN","IBCNEHL1",1,0)
IBCNEHL1 ;DAOU/ALA - HL7 Process Incoming RPI Messages ;26-JUN-2002
"RTN","IBCNEHL1",2,0)
;;2.0;INTEGRATED BILLING;**300,345,416,444,438,497,506,549,593,601,595,621,631**;21-MAR-94;Build 11
"RTN","IBCNEHL1",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHL1",4,0)
;
"RTN","IBCNEHL1",5,0)
;**Program Description**
"RTN","IBCNEHL1",6,0)
; This program will process incoming IIV response messages.
"RTN","IBCNEHL1",7,0)
; This includes updating the record in the IIV Response File,
"RTN","IBCNEHL1",8,0)
; updating the Buffer record (if there is one & creating a new
"RTN","IBCNEHL1",9,0)
; one if there isn't) with the appropriate Buffer Symbol & data
"RTN","IBCNEHL1",10,0)
;
"RTN","IBCNEHL1",11,0)
; Variables
"RTN","IBCNEHL1",12,0)
; ACK - Acknowledgment (AA=Accepted, AE=Error)
"RTN","IBCNEHL1",13,0)
; ERACT - Error Action
"RTN","IBCNEHL1",14,0)
; ERCON - Error Condition
"RTN","IBCNEHL1",15,0)
; ERFLG - Error quit flag
"RTN","IBCNEHL1",16,0)
; ERTXT - Error Message Text
"RTN","IBCNEHL1",17,0)
; HL - Array of HL7 variables
"RTN","IBCNEHL1",18,0)
; IBSEG - Optional, array of fields in segment
"RTN","IBCNEHL1",19,0)
; IIVSTAT - EC generated flag interpreting status of response
"RTN","IBCNEHL1",20,0)
; 1 = + (auto-update requirement)
"RTN","IBCNEHL1",21,0)
; 6 = -
"RTN","IBCNEHL1",22,0)
; V = #
"RTN","IBCNEHL1",23,0)
; MBI% = % ;will not receive from FSC, derived in FIL^IBCNEHL6
"RTN","IBCNEHL1",24,0)
; MBI# = # ;will not receive from FSC, derived in FIL^IBCNEHL6
"RTN","IBCNEHL1",25,0)
; MAP - Array that maps EC's IIV status flag to IIV STATUS TABLE (#365.15) IEN
"RTN","IBCNEHL1",26,0)
; MSGID - Original Message Control ID
"RTN","IBCNEHL1",27,0)
; RIEN - Response Record IEN
"RTN","IBCNEHL1",28,0)
; SEG - HL7 Segment Name
"RTN","IBCNEHL1",29,0)
;
"RTN","IBCNEHL1",30,0)
;IB*2.0*621/TAZ - Added to insure the routine is called via entry point EN with the event type.
"RTN","IBCNEHL1",31,0)
Q ;No direct entry to routine. Call label EN with parameter
"RTN","IBCNEHL1",32,0)
;
"RTN","IBCNEHL1",33,0)
;IB*2.0*621/TAZ - Added EVENTYP to control type of event processing.
"RTN","IBCNEHL1",34,0)
EN(EVENTYP) ;Entry Point
"RTN","IBCNEHL1",35,0)
;EVENTYP=1 > EICD Identification Response (RPI^IO4)
"RTN","IBCNEHL1",36,0)
;EVENTYP=2 > Normal 271 Response (RPI^IO1)
"RTN","IBCNEHL1",37,0)
N ACK,AUTO,EBDA,ERACT,ERCON,ERFLG,ERROR,ERTXT,G2OFLG,HCT,HLCMP,HLREP,HLSCMP,IBTRACK
"RTN","IBCNEHL1",38,0)
N IIVSTAT,IRIEN,MAP,MGRP,RIEN,RSUPDT,SEG,SUBID,TRACE,TRKIEN,UP
"RTN","IBCNEHL1",39,0)
S (ERFLG,G2OFLG)=0,MGRP=$$MGRP^IBCNEUT5(),HCT=1,SUBID="",IIVSTAT=""
"RTN","IBCNEHL1",40,0)
;
"RTN","IBCNEHL1",41,0)
S HLCMP=$E(HL("ECH")) ;HL7 component separator
"RTN","IBCNEHL1",42,0)
S HLSCMP=$E(HL("ECH"),4) ;HL7 subcomponent separator
"RTN","IBCNEHL1",43,0)
S HLREP=$E(HL("ECH"),2) ;HL7 repetition separator
"RTN","IBCNEHL1",44,0)
; Create map from EC to VistA
"RTN","IBCNEHL1",45,0)
S MAP(1)=8,MAP(6)=9,MAP("V")=21 ;These are X12 codes mapped from EC to VistA
"RTN","IBCNEHL1",46,0)
S MAP("MBI%")=26,MAP("MBI#")=27 ;These are NOT X12 codes from FSC - we derive them only for MBI responses
"RTN","IBCNEHL1",47,0)
;
"RTN","IBCNEHL1",48,0)
; Loop through the message & find each segment for processing
"RTN","IBCNEHL1",49,0)
F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D Q:ERFLG
"RTN","IBCNEHL1",50,0)
.D SPAR^IBCNEHLU
"RTN","IBCNEHL1",51,0)
.S SEG=$G(IBSEG(1))
"RTN","IBCNEHL1",52,0)
.; check if we are inside G2O group of segments
"RTN","IBCNEHL1",53,0)
.I SEG="ZTY" S G2OFLG=1
"RTN","IBCNEHL1",54,0)
.I G2OFLG,SEG'="ZTY",SEG'="CTD" S G2OFLG=0
"RTN","IBCNEHL1",55,0)
.; If we are outside of Z_Benefit_group, kill EB multiple ien
"RTN","IBCNEHL1",56,0)
.; I +$G(EBDA),".MSH.MSA.PRD.PID.GT1.IN1.IN3."[("."_SEG_".")!('G2OFLG&(SEG="CTD")) K EBDA
"RTN","IBCNEHL1",57,0)
.;
"RTN","IBCNEHL1",58,0)
.Q:SEG="PRD" ;IB*2*497 PRD segment is not processed
"RTN","IBCNEHL1",59,0)
.;
"RTN","IBCNEHL1",60,0)
.;IB*2.0*621 - The ZMS is an exact copy of MSA segment. It was added for the PIN^I07 message
"RTN","IBCNEHL1",61,0)
.I SEG="MSA" D MSA^IBCNEHL2(.ERACT,.ERCON,.ERROR,.ERTXT,.IBSEG,MGRP,.RIEN,.TRACE,EVENTYP) Q
"RTN","IBCNEHL1",62,0)
.I SEG="ZMS" D MSA^IBCNEHL2(.ERACT,.ERCON,.ERROR,.ERTXT,.IBSEG,MGRP,.RIEN,.TRACE,EVENTYP) Q
"RTN","IBCNEHL1",63,0)
.;
"RTN","IBCNEHL1",64,0)
.;Contact Segment
"RTN","IBCNEHL1",65,0)
.I SEG="CTD",'G2OFLG D CTD^IBCNEHL2(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",66,0)
.;
"RTN","IBCNEHL1",67,0)
.;Patient Segment
"RTN","IBCNEHL1",68,0)
.I SEG="PID" D PID^IBCNEHL2(.ERFLG,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",69,0)
.;
"RTN","IBCNEHL1",70,0)
.;Guarantor Segment
"RTN","IBCNEHL1",71,0)
.;IB*2.0*621/TAZ Pass EVENTYP along
"RTN","IBCNEHL1",72,0)
.I SEG="GT1" D GT1^IBCNEHL2(.ERROR,.IBSEG,RIEN,.SUBID,EVENTYP) Q
"RTN","IBCNEHL1",73,0)
.;
"RTN","IBCNEHL1",74,0)
.;Insurance Segment
"RTN","IBCNEHL1",75,0)
.;IB*2.0*621/TAZ Pass EVENTYP along
"RTN","IBCNEHL1",76,0)
.I SEG="IN1" D IN1^IBCNEHL2(.ERROR,.IBSEG,RIEN,SUBID,EVENTYP) Q
"RTN","IBCNEHL1",77,0)
.;
"RTN","IBCNEHL1",78,0)
.;Addt'l Insurance Segment
"RTN","IBCNEHL1",79,0)
.;I SEG="IN2" ; for future expansion, add IN2 tag to IBCNEHL2
"RTN","IBCNEHL1",80,0)
.;
"RTN","IBCNEHL1",81,0)
.;Addt'l Insurance - Cert Segment
"RTN","IBCNEHL1",82,0)
.I SEG="IN3" D IN3^IBCNEHL2(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",83,0)
.;
"RTN","IBCNEHL1",84,0)
.;IB*2*497 GROUP LEVEL REFERENCE ID segment (x12 loops 2100C & 2100D)
"RTN","IBCNEHL1",85,0)
. I SEG="ZRF",'$D(EBDA) D GZRF^IBCNEHL5(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",86,0)
.;
"RTN","IBCNEHL1",87,0)
.;Eligibility/Benefit Segment
"RTN","IBCNEHL1",88,0)
.I SEG="ZEB" D ZEB^IBCNEHL2(.EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",89,0)
.;
"RTN","IBCNEHL1",90,0)
.;Healthcare Delivery Segment
"RTN","IBCNEHL1",91,0)
.I SEG="ZHS" D ZHS^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",92,0)
.;
"RTN","IBCNEHL1",93,0)
.;Benefit level Reference ID Segment (X12 loops 2110C & 2110D)
"RTN","IBCNEHL1",94,0)
.I SEG="ZRF",+$G(EBDA) D ZRF^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q ;IB*2*497 add check to make sure z benefit group
"RTN","IBCNEHL1",95,0)
.;
"RTN","IBCNEHL1",96,0)
.;Subscriber Date Segment
"RTN","IBCNEHL1",97,0)
.I SEG="ZSD" D ZSD^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",98,0)
.;
"RTN","IBCNEHL1",99,0)
.;Subscriber Additional Info Segment
"RTN","IBCNEHL1",100,0)
.I SEG="ZII" D ZII^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",101,0)
.;
"RTN","IBCNEHL1",102,0)
.;Benefit Related Entity Segment
"RTN","IBCNEHL1",103,0)
.I SEG="ZTY" D ZTY^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",104,0)
.;
"RTN","IBCNEHL1",105,0)
.;Benefit Related Entity Contact Segment
"RTN","IBCNEHL1",106,0)
.I SEG="CTD",G2OFLG D G2OCTD^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",107,0)
.;
"RTN","IBCNEHL1",108,0)
.;Benefit Related Entity Notes Segment
"RTN","IBCNEHL1",109,0)
.I SEG="NTE",+$G(EBDA) D EBNTE^IBCNEHL2(EBDA,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",110,0)
.;
"RTN","IBCNEHL1",111,0)
.;Reject Reasons Segment
"RTN","IBCNEHL1",112,0)
.I SEG="ERR" K ERDA D ERR^IBCNEHL4(.ERDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",113,0)
.;
"RTN","IBCNEHL1",114,0)
.;Notes Segment
"RTN","IBCNEHL1",115,0)
.I SEG="NTE",'$D(EBDA),+$G(ERDA) D NTE^IBCNEHL4(ERDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",116,0)
.;
"RTN","IBCNEHL1",117,0)
.;Subscriber date segment (subscriber level)
"RTN","IBCNEHL1",118,0)
.I SEG="ZTP" D ZTP^IBCNEHL4(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",119,0)
. ;ib*2*497 - add processing for ROL, DG1, & ZMP segments
"RTN","IBCNEHL1",120,0)
. ;Provider Code segment
"RTN","IBCNEHL1",121,0)
. I SEG="ROL" D ROL^IBCNEHL5(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",122,0)
. ;
"RTN","IBCNEHL1",123,0)
. ;Health Care Diagnosis Code segment
"RTN","IBCNEHL1",124,0)
. I SEG="DG1" D DG1^IBCNEHL5(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",125,0)
. ;
"RTN","IBCNEHL1",126,0)
. ;Military Personnel Information segment
"RTN","IBCNEHL1",127,0)
. I SEG="ZMP" D ZMP^IBCNEHL5(.ERROR,.IBSEG,RIEN)
"RTN","IBCNEHL1",128,0)
;
"RTN","IBCNEHL1",129,0)
;IB*2.0*621/TAZ - File EICD Identification Response
"RTN","IBCNEHL1",130,0)
I EVENTYP=1 S TRKIEN=$$SVEICD^IBCNEHL7()
"RTN","IBCNEHL1",131,0)
;IB*2.0*621/TAZ - Update EIV EICD TRACKING FILE for EICD verification Response
"RTN","IBCNEHL1",132,0)
I EVENTYP=2 D
"RTN","IBCNEHL1",133,0)
. N D0,D1,FDA,IENS,TQN,EXT
"RTN","IBCNEHL1",134,0)
. S TQN=$$GET1^DIQ(365,RIEN_",",.05,"I")
"RTN","IBCNEHL1",135,0)
. S EXT=$$GET1^DIQ(365.1,TQN_",",.1,"I")
"RTN","IBCNEHL1",136,0)
. I EXT'=4 Q
"RTN","IBCNEHL1",137,0)
. S D0=$O(^IBCN(365.18,"C",TQN,"")) Q:'D0 S D1=$O(^IBCN(365.18,"C",TQN,D0,"")) Q:'D1
"RTN","IBCNEHL1",138,0)
. S IENS=D1_","_D0_","
"RTN","IBCNEHL1",139,0)
. S FDA(365.185,IENS,1.03)=RIEN
"RTN","IBCNEHL1",140,0)
. I ERACT'=""!(ERTXT'="") S FDA(365.185,IENS,1.04)=0 ;Error response
"RTN","IBCNEHL1",141,0)
. I IIVSTAT=1 S FDA(365.185,IENS,1.04)=1 ;Active
"RTN","IBCNEHL1",142,0)
. I IIVSTAT=6 S FDA(365.185,IENS,1.04)=2 ;Inactive
"RTN","IBCNEHL1",143,0)
. I IIVSTAT="V" S FDA(365.185,IENS,1.04)=3 ;Ambiguous
"RTN","IBCNEHL1",144,0)
. D FILE^DIE("","FDA"),CLEAN^DILF
"RTN","IBCNEHL1",145,0)
;
"RTN","IBCNEHL1",146,0)
S AUTO=$$AUTOUPD(RIEN)
"RTN","IBCNEHL1",147,0)
I $G(ACK)'="AE",$G(ERACT)="",$G(ERTXT)="",'$D(ERROR),+AUTO D Q
"RTN","IBCNEHL1",148,0)
.D:$P(AUTO,U,3)'="" AUTOFIL($P(AUTO,U,2),$P(AUTO,U,3),$P(AUTO,U,6))
"RTN","IBCNEHL1",149,0)
.D:$P(AUTO,U,4)'="" AUTOFIL($P(AUTO,U,2),$P(AUTO,U,4),$P(AUTO,U,6))
"RTN","IBCNEHL1",150,0)
.Q
"RTN","IBCNEHL1",151,0)
D FIL
"RTN","IBCNEHL1",152,0)
;
"RTN","IBCNEHL1",153,0)
ENX ;
"RTN","IBCNEHL1",154,0)
Q
"RTN","IBCNEHL1",155,0)
;
"RTN","IBCNEHL1",156,0)
;=================================================================
"RTN","IBCNEHL1",157,0)
AUTOFIL(DFN,IEN312,ISSUB) ;Finish processing the response message - file directly into patient insurance
"RTN","IBCNEHL1",158,0)
;
"RTN","IBCNEHL1",159,0)
N BUFF,DATA,ERROR,IENS,MIL,OKAY,PREL,RDATA0,RDATA1,RDATA5,RDATA13,RSTYPE,TQN,TSTAMP,XX ;IB*2.0*497 (vd)
"RTN","IBCNEHL1",160,0)
;
"RTN","IBCNEHL1",161,0)
Q:$G(RIEN)=""
"RTN","IBCNEHL1",162,0)
S TSTAMP=$$NOW^XLFDT(),IENS=IEN312_","_DFN_","
"RTN","IBCNEHL1",163,0)
S RDATA0=$G(^IBCN(365,RIEN,0)),RDATA1=$G(^IBCN(365,RIEN,1)),RDATA5=$G(^IBCN(365,RIEN,5))
"RTN","IBCNEHL1",164,0)
S RDATA13=$G(^IBCN(365,RIEN,13)) ;IB*2.0*497 (vd)
"RTN","IBCNEHL1",165,0)
S TQN=$P(RDATA0,U,5),RSTYPE=$P(RDATA0,U,10)
"RTN","IBCNEHL1",166,0)
;\Beginning IB*2.0*549 - Modified the following lines
"RTN","IBCNEHL1",167,0)
S XX=$$GET1^DIQ(2.312,IENS,7.01,"I")
"RTN","IBCNEHL1",168,0)
I ISSUB,XX="" S DATA(2.312,IENS,7.01)=$P(RDATA13,U) ;Name
"RTN","IBCNEHL1",169,0)
S XX=$$GET1^DIQ(2.312,IENS,3.01,"I")
"RTN","IBCNEHL1",170,0)
I XX="" S DATA(2.312,IENS,3.01)=$P(RDATA1,U,2) ;DOB
"RTN","IBCNEHL1",171,0)
S XX=$$GET1^DIQ(2.312,IENS,3.05,"I")
"RTN","IBCNEHL1",172,0)
I XX="" S DATA(2.312,IENS,3.05)=$P(RDATA1,U,3) ;SSN
"RTN","IBCNEHL1",173,0)
S XX=$$GET1^DIQ(2.312,IENS,6,"I")
"RTN","IBCNEHL1",174,0)
I ISSUB,XX="" S DATA(2.312,IENS,6)=$P(RDATA1,U,8) ;Whose insurance
"RTN","IBCNEHL1",175,0)
;pt. relationship (365,8.01) IB*2*497 code from 365,8.01 needs evaluation & possible conversion
"RTN","IBCNEHL1",176,0)
S PREL=$$GET1^DIQ(365,RIEN,8.01)
"RTN","IBCNEHL1",177,0)
S XX=$$GET1^DIQ(2.312,IENS,4.03,"I")
"RTN","IBCNEHL1",178,0)
I ISSUB,XX="",PREL'="" D
"RTN","IBCNEHL1",179,0)
. S DATA(2.312,IENS,4.03)=$$PREL^IBCNEHLU(2.312,4.03,PREL)
"RTN","IBCNEHL1",180,0)
;\End of IB*2.0*549 changes.
"RTN","IBCNEHL1",181,0)
;IB*2*595/DM moved the following 4 lines below
"RTN","IBCNEHL1",182,0)
;S DATA(2.312,IENS,1.03)=TSTAMP ;Date last verified
"RTN","IBCNEHL1",183,0)
;S DATA(2.312,IENS,1.04)="" ;Last verified by
"RTN","IBCNEHL1",184,0)
;S DATA(2.312,IENS,1.05)=TSTAMP ;Date last edited
"RTN","IBCNEHL1",185,0)
;S DATA(2.312,IENS,1.06)="" ;Last edited by
"RTN","IBCNEHL1",186,0)
;S DATA(2.312,IENS,1.09)=5 ;Source of info = eIV
"RTN","IBCNEHL1",187,0)
;IB*2.0*595/DM persist the original Source of Information
"RTN","IBCNEHL1",188,0)
;note: external values are used to populate DATA
"RTN","IBCNEHL1",189,0)
I $$GET1^DIQ(2.312,IENS,1.09,"I")="" D
"RTN","IBCNEHL1",190,0)
. S XX=$$GET1^DIQ(365.1,TQN_",1,",3.02)
"RTN","IBCNEHL1",191,0)
. I XX="" S XX="eIV"
"RTN","IBCNEHL1",192,0)
. S DATA(2.312,IENS,1.09)=XX
"RTN","IBCNEHL1",193,0)
;
"RTN","IBCNEHL1",194,0)
;Set Subscriber address Fields if none of the fields are currently defined
"RTN","IBCNEHL1",195,0)
;\Beginning IB*2.0*549 - Modified the following lines
"RTN","IBCNEHL1",196,0)
S XX=$$GET1^DIQ(2.312,IENS,3.06,"I") ;Current Ins Street Line 1
"RTN","IBCNEHL1",197,0)
I XX="" D
"RTN","IBCNEHL1",198,0)
. S XX=$$GET1^DIQ(2.312,IENS,3.07,"I") ;Current Ins Street Line 2
"RTN","IBCNEHL1",199,0)
. Q:XX'=""
"RTN","IBCNEHL1",200,0)
. S XX=$$GET1^DIQ(2.312,IENS,3.08,"I") ;Current Ins City
"RTN","IBCNEHL1",201,0)
. Q:XX'=""
"RTN","IBCNEHL1",202,0)
. S XX=$$GET1^DIQ(2.312,IENS,3.09,"I") ;Current Ins State
"RTN","IBCNEHL1",203,0)
. Q:XX'=""
"RTN","IBCNEHL1",204,0)
. S XX=$$GET1^DIQ(2.312,IENS,3.1,"I") ;Current Ins Zip
"RTN","IBCNEHL1",205,0)
. Q:XX'=""
"RTN","IBCNEHL1",206,0)
. S XX=$$GET1^DIQ(2.312,IENS,3.13,"I") ;Current Ins Country
"RTN","IBCNEHL1",207,0)
. Q:XX'=""
"RTN","IBCNEHL1",208,0)
. S XX=$$GET1^DIQ(2.312,IENS,3.14,"I") ;Current Ins Country Subdivision
"RTN","IBCNEHL1",209,0)
. Q:XX'=""
"RTN","IBCNEHL1",210,0)
. S DATA(2.312,IENS,3.06)=$P(RDATA5,U) ;Street line 1
"RTN","IBCNEHL1",211,0)
. S DATA(2.312,IENS,3.07)=$P(RDATA5,U,2) ;Street line 2
"RTN","IBCNEHL1",212,0)
. S DATA(2.312,IENS,3.08)=$P(RDATA5,U,3) ;City
"RTN","IBCNEHL1",213,0)
. S DATA(2.312,IENS,3.09)=$P(RDATA5,U,4) ;State
"RTN","IBCNEHL1",214,0)
. S DATA(2.312,IENS,3.1)=$P(RDATA5,U,5) ;Zip
"RTN","IBCNEHL1",215,0)
. S DATA(2.312,IENS,3.13)=$P(RDATA5,U,6) ;Country
"RTN","IBCNEHL1",216,0)
. S DATA(2.312,IENS,3.14)=$P(RDATA5,U,7) ;Country subdivision
"RTN","IBCNEHL1",217,0)
;\End of IB*2.0*549 changes.
"RTN","IBCNEHL1",218,0)
;
"RTN","IBCNEHL1",219,0)
L +^DPT(DFN,.312,IEN312):15 I '$T D LCKERR^IBCNEHL3 D FIL Q
"RTN","IBCNEHL1",220,0)
I $D(DATA) D FILE^DIE("ET","DATA","ERROR") ;IB*2*595/DM make sure DATA has data
"RTN","IBCNEHL1",221,0)
I $D(ERROR) D WARN^IBCNEHL3 K ERROR D FIL G AUTOFILX
"RTN","IBCNEHL1",222,0)
;IB*2*595/DM set auto-update fields
"RTN","IBCNEHL1",223,0)
;the EIV AUTO-UPDATE flag is now located in the IIV Response file
"RTN","IBCNEHL1",224,0)
;set eIV auto-update field separately because of the trigger on field 1.05
"RTN","IBCNEHL1",225,0)
;S DATA(2.312,IENS,4.04)="YES"
"RTN","IBCNEHL1",226,0)
K DATA
"RTN","IBCNEHL1",227,0)
S DATA(2.312,IENS,1.03)=TSTAMP ;Date last verified
"RTN","IBCNEHL1",228,0)
S DATA(2.312,IENS,1.04)="AUTOUPDATE,IBEIV" ;Last verified by ; Edit with 595 was null
"RTN","IBCNEHL1",229,0)
S DATA(2.312,IENS,1.05)=TSTAMP ;Date last edited
"RTN","IBCNEHL1",230,0)
S DATA(2.312,IENS,1.06)="AUTOUPDATE,IBEIV" ;Last edited by ; Edit with 595 was null
"RTN","IBCNEHL1",231,0)
D FILE^DIE("ET","DATA","ERROR")
"RTN","IBCNEHL1",232,0)
I $D(ERROR) D WARN^IBCNEHL3 G AUTOFILX
"RTN","IBCNEHL1",233,0)
;IB*2*595/DM set the insurance record IEN in the IIV Response file
"RTN","IBCNEHL1",234,0)
;to track which policy was updated based on the response
"RTN","IBCNEHL1",235,0)
D UPDIREC^IBCNEHL3(RIEN,IEN312)
"RTN","IBCNEHL1",236,0)
;IB*2*595/DM set the EIV AUTO-UPDATE in the response file to signal auto-update
"RTN","IBCNEHL1",237,0)
K DATA
"RTN","IBCNEHL1",238,0)
S DATA(365,RIEN_",",.13)="YES"
"RTN","IBCNEHL1",239,0)
D FILE^DIE("ET","DATA")
"RTN","IBCNEHL1",240,0)
;
"RTN","IBCNEHL1",241,0)
S ERFLG=$$GRPFILE(DFN,IEN312,RIEN,1)
"RTN","IBCNEHL1",242,0)
I $G(ERFLG) G AUTOFILX ;IB*2*497 file data at 2.312, 9, 10 & 11 subfiles; if error is produced update buffer entry & then quit processing
"RTN","IBCNEHL1",243,0)
;file new EB data
"RTN","IBCNEHL1",244,0)
S ERFLG=$$EBFILE(DFN,IEN312,RIEN,1)
"RTN","IBCNEHL1",245,0)
;bail out if something went wrong during filing of EB data
"RTN","IBCNEHL1",246,0)
I $G(ERFLG) G AUTOFILX
"RTN","IBCNEHL1",247,0)
;update insurance record ien in transmission queue
"RTN","IBCNEHL1",248,0)
D UPDIREC^IBCNEHL3(RIEN,IEN312)
"RTN","IBCNEHL1",249,0)
;For an original response, set the Transmission Queue Status to 'Response Received' &
"RTN","IBCNEHL1",250,0)
;update remaining retries to comm failure (5)
"RTN","IBCNEHL1",251,0)
I $G(RSTYPE)="O" D SST^IBCNEUT2(TQN,3),RSTA^IBCNEUT7(TQN)
"RTN","IBCNEHL1",252,0)
;update buffer file entry so only stub remains & status is changed
"RTN","IBCNEHL1",253,0)
S BUFF=+$P($G(^IBCN(365,RIEN,0)),U,4)
"RTN","IBCNEHL1",254,0)
I BUFF D
"RTN","IBCNEHL1",255,0)
.D STATUS^IBCNBEE(BUFF,"A",0,0,0) ;update buffer entry's status to accepted
"RTN","IBCNEHL1",256,0)
.D DELDATA^IBCNBED(BUFF) ;delete buffer's insurance/patient data
"RTN","IBCNEHL1",257,0)
;
"RTN","IBCNEHL1",258,0)
;IB*2*631/vd - Start of new code for filing data to #355.36 file.
"RTN","IBCNEHL1",259,0)
N ERROR,FDA,WE
"RTN","IBCNEHL1",260,0)
S WE=$$GET1^DIQ(365.1,TQN_",",.1,"I")
"RTN","IBCNEHL1",261,0)
S FDA(355.36,"+1,",.01)=$$NOW^XLFDT ;Date Processed
"RTN","IBCNEHL1",262,0)
S FDA(355.36,"+1,",.02)=$S("^5^6^"[(U_WE_U):3,"^1^2^3^"[(U_WE_U):1,1:"") ;"WE" Should never be 4 or 7 at this point
"RTN","IBCNEHL1",263,0)
S FDA(355.36,"+1,",.03)=$$GET1^DIQ(365.1,TQN_",",3.02,"I") ;Source of Information
"RTN","IBCNEHL1",264,0)
S FDA(355.36,"+1,",.04)=$$GET1^DIQ(365,RIEN_",",.13,"I") ;EIV Auto-Update
"RTN","IBCNEHL1",265,0)
S FDA(355.36,"+1,",.05)=TQN ;EIV Inquiry
"RTN","IBCNEHL1",266,0)
S FDA(355.36,"+1,",.06)=RIEN ;IV Response
"RTN","IBCNEHL1",267,0)
S FDA(355.36,"+1,",.07)=$G(IBBUFDA) ;Buffer
"RTN","IBCNEHL1",268,0)
S FDA(355.36,"+1,",.08)=WE ;Source of Request (Which Extract)
"RTN","IBCNEHL1",269,0)
D UPDATE^DIE("","FDA",,"ERROR")
"RTN","IBCNEHL1",270,0)
I $D(ERROR) D
"RTN","IBCNEHL1",271,0)
. D MSG003^IBCNEMS1(.IBMSG,.ERROR,TQN,RIEN,$G(IBBUFDA))
"RTN","IBCNEHL1",272,0)
. D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: Error writing to the CREATION TO PROCESSING TRACKING File (#355.36)","IBMSG(")
"RTN","IBCNEHL1",273,0)
;IB*2*631/vd - End of new code.
"RTN","IBCNEHL1",274,0)
;
"RTN","IBCNEHL1",275,0)
AUTOFILX ;
"RTN","IBCNEHL1",276,0)
L -^DPT(DFN,.312,IEN312)
"RTN","IBCNEHL1",277,0)
Q
"RTN","IBCNEHL1",278,0)
;
"RTN","IBCNEHL1",279,0)
GRPFILE(DFN,IEN312,RIEN,AFLG) ;ib*2*497 file data at node 12 & at subfiles 2.312,9, 10 & 11
"RTN","IBCNEHL1",280,0)
;DFN - file 2 ien
"RTN","IBCNEHL1",281,0)
;IEN312 - file 2.312 ien
"RTN","IBCNEHL1",282,0)
;RIEN = file 365 ien
"RTN","IBCNEHL1",283,0)
;AFLG - 1 if called from autoupdate, 0 if called from ins. buffer process entry
"RTN","IBCNEHL1",284,0)
;output - returns 0 or 1
"RTN","IBCNEHL1",285,0)
; 0 - entry update received an error when attempting to file
"RTN","IBCNEHL1",286,0)
; 1 - successful update
"RTN","IBCNEHL1",287,0)
N DA,DATA12,DIAG,DIAG3121,ERFLG,ERROR,IENS,IENS365,IENS312,NODE,PROV,PROV332,REF,REF3129,Z,Z2
"RTN","IBCNEHL1",288,0)
;retrieve external values of data located at node 12 of 365
"RTN","IBCNEHL1",289,0)
S IENS=IEN312_","_DFN_","
"RTN","IBCNEHL1",290,0)
D GETS^DIQ(365,RIEN,"12.01:12.07",,"MIL")
"RTN","IBCNEHL1",291,0)
M DATA12(2.312,IENS)=MIL(365,RIEN_",")
"RTN","IBCNEHL1",292,0)
D FILE^DIE("ET","DATA12","ERROR")
"RTN","IBCNEHL1",293,0)
I $D(ERROR) D:AFLG WARN^IBCNEHL3 K ERROR
"RTN","IBCNEHL1",294,0)
;remove existing sub-file entries at nodes 9, 10, & 11 before update of new data
"RTN","IBCNEHL1",295,0)
F NODE="9","10","11" D
"RTN","IBCNEHL1",296,0)
. S DIK="^DPT("_DFN_",.312,"_IEN312_","_NODE_",",DA(2)=DFN,DA(1)=IEN312
"RTN","IBCNEHL1",297,0)
. S DA=0 F S DA=$O(^DPT(DFN,.312,IEN312,NODE,DA)) Q:DA=""!(DA?1.A) D ^DIK
"RTN","IBCNEHL1",298,0)
S IENS312="+1,"_IEN312_","_DFN_","
"RTN","IBCNEHL1",299,0)
;update node 9 data
"RTN","IBCNEHL1",300,0)
S Z="" F S Z=$O(^IBCN(365,RIEN,9,"B",Z)) Q:'Z D
"RTN","IBCNEHL1",301,0)
. S IENS365=$O(^IBCN(365,RIEN,9,"B",Z,""))_","_RIEN_","
"RTN","IBCNEHL1",302,0)
. D GETS^DIQ(365.09,IENS365,"*",,"REF")
"RTN","IBCNEHL1",303,0)
S Z2="" F S Z2=$O(REF(365.09,Z2)) Q:Z2="" M REF3129(2.3129,IENS312)=REF(365.09,Z2) D UPDATE^DIE("E","REF3129",,"ERROR") K REF3129 I $D(ERROR) D:AFLG WARN^IBCNEHL3 K ERROR
"RTN","IBCNEHL1",304,0)
;update node 10 data
"RTN","IBCNEHL1",305,0)
S Z="" F S Z=$O(^IBCN(365,RIEN,10,"B",Z)) Q:'Z D
"RTN","IBCNEHL1",306,0)
. S IENS365=$O(^IBCN(365,RIEN,10,"B",Z,""))_","_RIEN_","
"RTN","IBCNEHL1",307,0)
. D GETS^DIQ(365.04,IENS365,"*",,"PROV")
"RTN","IBCNEHL1",308,0)
S Z2="" F S Z2=$O(PROV(365.04,Z2)) Q:Z2="" M PROV332(2.332,IENS312)=PROV(365.04,Z2) D UPDATE^DIE("E","PROV332",,"ERROR") K PROV332 I $D(ERROR) D:AFLG WARN^IBCNEHL3 K ERROR
"RTN","IBCNEHL1",309,0)
;update node 11 data
"RTN","IBCNEHL1",310,0)
S Z="" F S Z=$O(^IBCN(365,RIEN,11,"B",Z)) Q:'Z D
"RTN","IBCNEHL1",311,0)
. S IENS365=$O(^IBCN(365,RIEN,11,"B",Z,""))_","_RIEN_","
"RTN","IBCNEHL1",312,0)
. D GETS^DIQ(365.01,IENS365,"*",,"DIAG")
"RTN","IBCNEHL1",313,0)
S Z2="" F S Z2=$O(DIAG(365.01,Z2)) Q:Z2="" M DIAG3121(2.31211,IENS312)=DIAG(365.01,Z2) D UPDATE^DIE("E","DIAG3121",,"ERROR") K DIAG3121 I $D(ERROR) D:AFLG WARN^IBCNEHL3 K ERROR
"RTN","IBCNEHL1",314,0)
GRPFILEX ;
"RTN","IBCNEHL1",315,0)
Q $G(ERFLG)
"RTN","IBCNEHL1",316,0)
;
"RTN","IBCNEHL1",317,0)
FIL ;Finish processing the response message - file into insurance buffer
"RTN","IBCNEHL1",318,0)
;IB*2*601/DM FIL()routine moved to IBCNEHL6 to meet SAC guidelines due to size
"RTN","IBCNEHL1",319,0)
D FIL^IBCNEHL6
"RTN","IBCNEHL1",320,0)
Q
"RTN","IBCNEHL1",321,0)
;
"RTN","IBCNEHL1",322,0)
AUTOUPD(RIEN) ;
"RTN","IBCNEHL1",323,0)
;Returns "1^file 2 ien^file 2.312 ien^2nd file 2.312 ien^Medicare flag^subscriber flag", if entry
"RTN","IBCNEHL1",324,0)
;in file 365 is eligible for auto-update, returns 0 otherwise.
"RTN","IBCNEHL1",325,0)
;
"RTN","IBCNEHL1",326,0)
;Medicare flag: 1 for Medicare, 0 otherwise
"RTN","IBCNEHL1",327,0)
;Subscriber flag: 1 if patient is the subscriber, 0 otherwise
"RTN","IBCNEHL1",328,0)
;
"RTN","IBCNEHL1",329,0)
;For non-Medicare response: 1st file 2.312 ien is set, 2nd file 2.312 ien is empty, pieces 5-7 are empty
"RTN","IBCNEHL1",330,0)
;For Medicare response: 1st file 2.312 ien contains ien for Medicare Part A, 2nd file 2.312 ien contains ien for Medicare Part B,
"RTN","IBCNEHL1",331,0)
; either one may be empty, but at least one of them is set if entry is eligible.
"RTN","IBCNEHL1",332,0)
;
"RTN","IBCNEHL1",333,0)
;RIEN - ien in file 365
"RTN","IBCNEHL1",334,0)
;
"RTN","IBCNEHL1",335,0)
N APPIEN,GDATA,GIEN,GNAME,GNUM,GNUM1,GOK,IEN2,IEN312,IEN36,IDATA0,IDATA3,ISSUB,MWNRA,MWNRB,MWNRIEN,MWNRTYP
"RTN","IBCNEHL1",336,0)
N ONEPOL,PIEN,RDATA0,RDATA1,RES,TQIEN,IDATA7,RDATA13,RDATA14 ;IB*2.0*497
"RTN","IBCNEHL1",337,0)
S RES=0
"RTN","IBCNEHL1",338,0)
I +$G(RIEN)'>0 Q RES ;Invalid ien for file 365
"RTN","IBCNEHL1",339,0)
;IB*2.0*595/DM if entry is missing from #200, file in buffer
"RTN","IBCNEHL1",340,0)
I '$$FIND1^DIC(200,,"M","AUTOUPDATE,IBEIV") Q RES
"RTN","IBCNEHL1",341,0)
;
"RTN","IBCNEHL1",342,0)
;IB*2.0*549 - Moved up the next 5 lines. Originally, these lines were
"RTN","IBCNEHL1",343,0)
; directly after line 'I $G(IIVSTAT)'=1 Q RES'
"RTN","IBCNEHL1",344,0)
S RDATA0=$G(^IBCN(365,RIEN,0)),RDATA1=$G(^IBCN(365,RIEN,1))
"RTN","IBCNEHL1",345,0)
;
"RTN","IBCNEHL1",346,0)
;IB*2.0*497 - longer fields for GROUP NAME, GROUP NUMBER, NAME OF INSURED, & SUBSCRIBER ID
"RTN","IBCNEHL1",347,0)
S RDATA13=$G(^IBCN(365,RIEN,13)),RDATA14=$G(^IBCN(365,RIEN,14))
"RTN","IBCNEHL1",348,0)
S PIEN=$P(RDATA0,U,3)
"RTN","IBCNEHL1",349,0)
;
"RTN","IBCNEHL1",350,0)
;IB*2.0*549 - Moved up the next 2 lines. Originally, these lines were
"RTN","IBCNEHL1",351,0)
; directly after 'S IEN2=$P(RDATA0,U,2) I +IEN2'>0 Q RES'
"RTN","IBCNEHL1",352,0)
S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25),MWNRTYP=0,(MWNRA,MWNRB)=""
"RTN","IBCNEHL1",353,0)
I PIEN=MWNRIEN S MWNRTYP=$$ISMCR^IBCNEHLU(RIEN)
"RTN","IBCNEHL1",354,0)
;
"RTN","IBCNEHL1",355,0)
;IB*2.0*549 - Added ',MWNRTYP' below to only quit for non-medicare policies
"RTN","IBCNEHL1",356,0)
I $G(IIVSTAT)'=1,'MWNRTYP Q RES ;Only auto-update 'active policy' responses
"RTN","IBCNEHL1",357,0)
I +PIEN>0 S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
"RTN","IBCNEHL1",358,0)
I +$G(APPIEN)'>0 Q RES ;couldn't find eIV application entry
"RTN","IBCNEHL1",359,0)
;
"RTN","IBCNEHL1",360,0)
;IB*2.0*601/HN Don't allow any entry with HMS SOI to auto-update
"RTN","IBCNEHL1",361,0)
;IB*2.0*595/HN Don't allow any entry with Contract Services SOI to auto-update
"RTN","IBCNEHL1",362,0)
I $P(RDATA0,U,5)'="" I "^HMS^CONTRACT SERVICES^"[("^"_$$GET1^DIQ(365.1,$P(RDATA0,U,5)_",","SOURCE OF INFORMATION","E")_"^") Q RES ; HAN IB*2.0*621
"RTN","IBCNEHL1",363,0)
;Check dictionary 365.1 MANUAL REQUEST DATE/TIME Flag, Quit if Set.
"RTN","IBCNEHL1",364,0)
I $P(RDATA0,U,5)'="",$P($G(^IBCN(365.1,$P(RDATA0,U,5),3)),U,1)'="" Q RES
"RTN","IBCNEHL1",365,0)
I $P(^IBE(365.12,PIEN,1,APPIEN,0),U,7)=0 Q RES ; auto-accept is OFF
"RTN","IBCNEHL1",366,0)
S IEN2=$P(RDATA0,U,2) I +IEN2'>0 Q RES ; couldn't find patient
"RTN","IBCNEHL1",367,0)
S ONEPOL=$$ONEPOL^IBCNEHLU(PIEN,IEN2)
"RTN","IBCNEHL1",368,0)
;try to find a matching pat. insurance
"RTN","IBCNEHL1",369,0)
S IEN36="" F S IEN36=$O(^DIC(36,"AC",PIEN,IEN36)) Q:IEN36=""!(RES>0) D
"RTN","IBCNEHL1",370,0)
.S IEN312="" F S IEN312=$O(^DPT(IEN2,.312,"B",IEN36,IEN312)) Q:IEN312=""!(RES>0&('+MWNRTYP)) D
"RTN","IBCNEHL1",371,0)
..S IDATA0=$G(^DPT(IEN2,.312,IEN312,0)),IDATA3=$G(^DPT(IEN2,.312,IEN312,3))
"RTN","IBCNEHL1",372,0)
..S IDATA7=$G(^DPT(IEN2,.312,IEN312,7)) ;IB*2.0*497 (vd)
"RTN","IBCNEHL1",373,0)
..I $$EXPIRED^IBCNEDE2($P(IDATA0,U,4)) Q ;Insurance policy has expired
"RTN","IBCNEHL1",374,0)
..S ISSUB=$$PATISSUB^IBCNEHLU(IDATA0)
"RTN","IBCNEHL1",375,0)
..;Patient is the subscriber
"RTN","IBCNEHL1",376,0)
..I ISSUB,'$$CHK1^IBCNEHL3 Q
"RTN","IBCNEHL1",377,0)
..;Patient is the dependent
"RTN","IBCNEHL1",378,0)
..I 'ISSUB,'$$CHK2^IBCNEHL3(MWNRTYP) Q
"RTN","IBCNEHL1",379,0)
..;check group #
"RTN","IBCNEHL1",380,0)
..S GNUM=$P(RDATA14,U,2),GIEN=+$P(IDATA0,U,18),GOK=1 ;IB*2*497 - group # needs to be retrieved from new field
"RTN","IBCNEHL1",381,0)
..;check non-Medicare group #
"RTN","IBCNEHL1",382,0)
..I '+MWNRTYP D Q:'GOK ;Group # doesn't match
"RTN","IBCNEHL1",383,0)
...I 'ONEPOL D
"RTN","IBCNEHL1",384,0)
....I GIEN'>0 S GOK=0 Q
"RTN","IBCNEHL1",385,0)
....S GNUM1=$P($G(^IBA(355.3,GIEN,2)),U,2) ;IB*2.0*497 (vd)
"RTN","IBCNEHL1",386,0)
....I GNUM=""!(GNUM1="")!(GNUM'=GNUM1) S GOK=0
"RTN","IBCNEHL1",387,0)
....Q
"RTN","IBCNEHL1",388,0)
...I ONEPOL D
"RTN","IBCNEHL1",389,0)
....I GNUM'="",GIEN'="" S GNUM1=$P($G(^IBA(355.3,GIEN,2)),U,2) I GNUM1'="",GNUM'=GNUM1 S GOK=0 ;IB*2.0*497 (vd)
"RTN","IBCNEHL1",390,0)
....Q
"RTN","IBCNEHL1",391,0)
...Q
"RTN","IBCNEHL1",392,0)
..;check for Medicare part A/B
"RTN","IBCNEHL1",393,0)
..I +MWNRTYP D Q:'GOK ;Group # doesn't match
"RTN","IBCNEHL1",394,0)
...I GIEN'>0 S GOK=0 Q
"RTN","IBCNEHL1",395,0)
...S GDATA=$G(^IBA(355.3,GIEN,0))
"RTN","IBCNEHL1",396,0)
...I $P(GDATA,U,14)="A" D
"RTN","IBCNEHL1",397,0)
....;IB*2.0*549 Change $P(MWNRTYP,U,2)="MA"!($P(MWNRTYP,U,2)="B")
"RTN","IBCNEHL1",398,0)
....; To $P(MWNRTYP,U,5)="MA"!($P(MWNRTYP,U,5)="B")
"RTN","IBCNEHL1",399,0)
....I $P(MWNRTYP,U,5)="MA"!($P(MWNRTYP,U,5)="B") S MWNRA=IEN312 Q
"RTN","IBCNEHL1",400,0)
....S GOK=0
"RTN","IBCNEHL1",401,0)
....Q
"RTN","IBCNEHL1",402,0)
...I $P(GDATA,U,14)="B" D
"RTN","IBCNEHL1",403,0)
....;IB*2.0*549 Change $P(MWNRTYP,U,2)="MB"!($P(MWNRTYP,U,2)="B")
"RTN","IBCNEHL1",404,0)
....; To $P(MWNRTYP,U,5)="MB"!($P(MWNRTYP,U,5)="B")
"RTN","IBCNEHL1",405,0)
....I $P(MWNRTYP,U,5)="MB"!($P(MWNRTYP,U,5)="B") S MWNRB=IEN312 Q
"RTN","IBCNEHL1",406,0)
....S GOK=0
"RTN","IBCNEHL1",407,0)
....Q
"RTN","IBCNEHL1",408,0)
...Q
"RTN","IBCNEHL1",409,0)
..S RES=1_U_IEN2_U_$S(+MWNRTYP:MWNRA_U_MWNRB_U_1,1:IEN312_U_U_0)
"RTN","IBCNEHL1",410,0)
..S $P(RES,U,6)=ISSUB
"RTN","IBCNEHL1",411,0)
..Q
"RTN","IBCNEHL1",412,0)
.Q
"RTN","IBCNEHL1",413,0)
Q RES
"RTN","IBCNEHL1",414,0)
;
"RTN","IBCNEHL1",415,0)
EBFILE(DFN,IEN312,RIEN,AFLG) ;File eligibility/benefit data from file 365 into file 2.312
"RTN","IBCNEHL1",416,0)
;Input: DFN - Internal Patient IEN
"RTN","IBCNEHL1",417,0)
; IEN312 - Insurance multiple #
"RTN","IBCNEHL1",418,0)
; RIEN - file 365 ien
"RTN","IBCNEHL1",419,0)
; AFLG - 1 if called from autoupdate
"RTN","IBCNEHL1",420,0)
; 0 if called from ins. buffer process entry
"RTN","IBCNEHL1",421,0)
;Returns: "" on success, ERFLG on failure. Also called from ACCEPT^IBCNBAR
"RTN","IBCNEHL1",422,0)
; for manual processing of ins. buffer entry.
"RTN","IBCNEHL1",423,0)
;
"RTN","IBCNEHL1",424,0)
Q $$EBFILE^IBCNEHL5(DFN,IEN312,RIEN,AFLG) ;IB*2.0*549 moved because of routine size
"RTN","IBCNEHL1",425,0)
;
"RTN","IBCNEHLM")
0^6^B24245896^B24096430
"RTN","IBCNEHLM",1,0)
IBCNEHLM ;DAOU/ALA - HL7 Registration MFN Message ;02-JUN-2015
"RTN","IBCNEHLM",2,0)
;;2.0;INTEGRATED BILLING;**184,251,300,416,438,497,506,549,601,621,631**;21-MAR-94;Build 11
"RTN","IBCNEHLM",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHLM",4,0)
;
"RTN","IBCNEHLM",5,0)
;**Program Description**
"RTN","IBCNEHLM",6,0)
; This program will process the outgoing registration MFN message
"RTN","IBCNEHLM",7,0)
;
"RTN","IBCNEHLM",8,0)
; Variables
"RTN","IBCNEHLM",9,0)
; MCT = Lines of MailMan message counter
"RTN","IBCNEHLM",10,0)
; QFL = Quit flag
"RTN","IBCNEHLM",11,0)
; HL* = HL7 package specific variables
"RTN","IBCNEHLM",12,0)
; TAXID = Tax ID
"RTN","IBCNEHLM",13,0)
; CNTCPH = Contact Phone
"RTN","IBCNEHLM",14,0)
; CNTCEM = Contact Email
"RTN","IBCNEHLM",15,0)
; FRSH = Freshness Days
"RTN","IBCNEHLM",16,0)
; MGRP = Mailgroup to email messages to
"RTN","IBCNEHLM",17,0)
; INACT = Inactive Insurance Flag
"RTN","IBCNEHLM",18,0)
; APP = Application
"RTN","IBCNEHLM",19,0)
; EVENT = HL7 Event
"RTN","IBCNEHLM",20,0)
; CODE = Values sent in the MFN message
"RTN","IBCNEHLM",21,0)
; IPP = IP Port
"RTN","IBCNEHLM",22,0)
; IPA = IP Address
"RTN","IBCNEHLM",23,0)
; RESP = Response Code
"RTN","IBCNEHLM",24,0)
; IHLP = Interface HL7 Processing Type
"RTN","IBCNEHLM",25,0)
; IHLT = Interface HL7 Batch Start Time
"RTN","IBCNEHLM",26,0)
; IHLS = Interface HL7 Batch Stop Time
"RTN","IBCNEHLM",27,0)
; IVER = Interface Version
"RTN","IBCNEHLM",28,0)
; TIMOUT = Timeout Days Site Parameter
"RTN","IBCNEHLM",29,0)
; RETRY = Retry Flag Site Parameter
"RTN","IBCNEHLM",30,0)
;
"RTN","IBCNEHLM",31,0)
N IBPERSIST
"RTN","IBCNEHLM",32,0)
S IBPERSIST="N" ; persistence flag - If "N", FSC will not use the statistics on the NTE segment
"RTN","IBCNEHLM",33,0)
D REG
"RTN","IBCNEHLM",34,0)
Q
"RTN","IBCNEHLM",35,0)
;
"RTN","IBCNEHLM",36,0)
EN1 ; TaskMan entry point
"RTN","IBCNEHLM",37,0)
N IBPERSIST
"RTN","IBCNEHLM",38,0)
S IBPERSIST="Y" ; persistence flag - If "Y", FSC will use NTE segment to update their copy of the site's stats
"RTN","IBCNEHLM",39,0)
D REG
"RTN","IBCNEHLM",40,0)
; Purge the task record
"RTN","IBCNEHLM",41,0)
S ZTREQ="@"
"RTN","IBCNEHLM",42,0)
Q
"RTN","IBCNEHLM",43,0)
;
"RTN","IBCNEHLM",44,0)
REG ; Registration message for when a site installs
"RTN","IBCNEHLM",45,0)
N APP,CNTCEM,CNTCNM,CNTCPH,CODE,EDT,EVENT,FRSH,HL,HLCDOM,HLCINS,HLCS
"RTN","IBCNEHLM",46,0)
N HLCSTCP,HLECH,HLEID,HLFS,HLHDR,HLINST,HLIP,HLN,HLNHLQ,HLPROD,HLQ,HLREP
"RTN","IBCNEHLM",47,0)
N HLRESLT,HLSAN,HLTYPE,HLX,IBCNE,IBCNEDAT,IHLP,IHLS,IHLT,ID,INACT,IPA,IPP
"RTN","IBCNEHLM",48,0)
N MCT,MFE,MFN,MGRP,QFL,RESP,TAXID,ZMID,%I
"RTN","IBCNEHLM",49,0)
N IVER,RETRY,TIMOUT,VMFE ; IB*2.0*506
"RTN","IBCNEHLM",50,0)
K ^TMP("HLS",$J) S MCT=0,QFL=0
"RTN","IBCNEHLM",51,0)
;
"RTN","IBCNEHLM",52,0)
; Get data from IB Parameters File
"RTN","IBCNEHLM",53,0)
S TAXID=$TR($P($G(^IBE(350.9,1,1)),U,5),"-",""),CNTCPH="",CNTCEM="",CNTCNM=""
"RTN","IBCNEHLM",54,0)
S IBCNE=$G(^IBE(350.9,1,51))
"RTN","IBCNEHLM",55,0)
S FRSH=$P(IBCNE,U,1),TIMOUT=$P(IBCNE,U,5),RETRY=$P(IBCNE,U,26) ; IB*2.0*506
"RTN","IBCNEHLM",56,0)
S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNEHLM",57,0)
S INACT=$E($$GET1^DIQ(350.9,"1,",51.08,"E"))
"RTN","IBCNEHLM",58,0)
S IHLP=$P(IBCNE,U,13),IHLT=$P(IBCNE,U,14)
"RTN","IBCNEHLM",59,0)
S IHLS=$P(IBCNE,U,19)
"RTN","IBCNEHLM",60,0)
;
"RTN","IBCNEHLM",61,0)
; IB*2.0*549 Updated version to 7, Removed retrieval of Contact Name, Phone, email
"RTN","IBCNEHLM",62,0)
; IB*2.0*601 Updated version to 8
"RTN","IBCNEHLM",63,0)
; IB*2.0*621 Updated version to 9, EICD
"RTN","IBCNEHLM",64,0)
; IB*2.0*631 Updated version to 10
"RTN","IBCNEHLM",65,0)
S IVER="10"
"RTN","IBCNEHLM",66,0)
I IHLP="I" S (IHLT,IHLS)=""
"RTN","IBCNEHLM",67,0)
;
"RTN","IBCNEHLM",68,0)
I IHLP="B",IHLT=""!(IHLS="") D S QFL=1
"RTN","IBCNEHLM",69,0)
. S MCT=MCT+1,MSG(MCT)="The ""HL7 Response Processing Method"" selected is Batch but the HL7 Batch "
"RTN","IBCNEHLM",70,0)
. I IHLT="",IHLS="" S MSG(MCT)=MSG(MCT)_"Start and End Times are blank. " Q
"RTN","IBCNEHLM",71,0)
. S MSG(MCT)=MSG(MCT)_$S(IHLT="":"Start",1:"End")_" Time is blank. "
"RTN","IBCNEHLM",72,0)
;
"RTN","IBCNEHLM",73,0)
I FRSH=""!(INACT="")!(IHLP="") D
"RTN","IBCNEHLM",74,0)
. S MCT=MCT+1,MSG(MCT)="The following eIV Site Parameters are not defined: "
"RTN","IBCNEHLM",75,0)
. I FRSH="" S MCT=MCT+1,MSG(MCT)="""Days between electronic re-verification checks"" is blank. "
"RTN","IBCNEHLM",76,0)
. I INACT="" S MCT=MCT+1,MSG(MCT)="""Look at a patient's inactive insurance?"" is blank. "
"RTN","IBCNEHLM",77,0)
. I IHLP="" S MCT=MCT+1,MSG(MCT)="""HL7 Response Processing Method"" is blank. "
"RTN","IBCNEHLM",78,0)
. Q
"RTN","IBCNEHLM",79,0)
;
"RTN","IBCNEHLM",80,0)
I $O(MSG(""))'="" D MLMN
"RTN","IBCNEHLM",81,0)
I QFL=1 Q
"RTN","IBCNEHLM",82,0)
;
"RTN","IBCNEHLM",83,0)
HL ; When a site installs, the enrollment should be an
"RTN","IBCNEHLM",84,0)
; "MUP" (update) record.
"RTN","IBCNEHLM",85,0)
N DSTAT,DSTAT2,VNTE,VZRR ; IB*2.0*549 added DSTAT2
"RTN","IBCNEHLM",86,0)
S MFE(1)="MUP"
"RTN","IBCNEHLM",87,0)
;
"RTN","IBCNEHLM",88,0)
; Initialize the HL7
"RTN","IBCNEHLM",89,0)
D INIT^HLFNC2("IBCNE IIV REGISTER",.HL)
"RTN","IBCNEHLM",90,0)
S HLFS=HL("FS"),HLECH=HL("ECH"),HL("SAF")=$P($$SITE^VASITE,U,2,3),HLREP=$E(HL("ECH"),2)
"RTN","IBCNEHLM",91,0)
; S HLEID=$$HLP^IBCNEHLU("IBCNE IIV REGISTER")
"RTN","IBCNEHLM",92,0)
;
"RTN","IBCNEHLM",93,0)
; Set the MFI segment
"RTN","IBCNEHLM",94,0)
S ID="Facility Table",APP="",EVENT="UPD",RESP="NE"
"RTN","IBCNEHLM",95,0)
S ^TMP("HLS",$J,1)=$$MFI^VAFHLMFI(ID,APP,EVENT,,,RESP)
"RTN","IBCNEHLM",96,0)
;
"RTN","IBCNEHLM",97,0)
; Set the MFE segment
"RTN","IBCNEHLM",98,0)
S EVENT=MFE(1),MFN="",EDT=$$DT^XLFDT()
"RTN","IBCNEHLM",99,0)
S CODE=$P($$SITE^VASITE,U,3)_$E(HLECH)
"RTN","IBCNEHLM",100,0)
S VMFE=$$MFE^VAFHLMFE(EVENT,MFN,EDT,CODE)
"RTN","IBCNEHLM",101,0)
S ^TMP("HLS",$J,2)=VMFE_HLFS_"CE"
"RTN","IBCNEHLM",102,0)
;
"RTN","IBCNEHLM",103,0)
; Set the ZRR segment
"RTN","IBCNEHLM",104,0)
;IB*549 Added line to send null values for removed fields so msg layout remains unchanged
"RTN","IBCNEHLM",105,0)
S (CNTCPH,CNTCEM,CNTCNM)=""
"RTN","IBCNEHLM",106,0)
S VZRR="ZRR"_HLFS_"1"_HLFS_TAXID_HLFS_HLFS_$$HLNAME^HLFNC(CNTCNM,$E(HLECH))_"^C"_HLFS
"RTN","IBCNEHLM",107,0)
S VZRR=VZRR_CNTCPH_$E(HLECH)_$E(HLECH)_$E(HLECH)_CNTCEM_HLFS_FRSH_HLFS_IHLP_HLFS_IHLT_$E(HLECH)_IHLS_HLFS_INACT_HLFS_IVER
"RTN","IBCNEHLM",108,0)
S ^TMP("HLS",$J,3)=VZRR
"RTN","IBCNEHLM",109,0)
;
"RTN","IBCNEHLM",110,0)
; Set the NTE segment
"RTN","IBCNEHLM",111,0)
S DSTAT=$$GETSTAT^IBCNEDST()
"RTN","IBCNEHLM",112,0)
S DSTAT2=$$GETSTAT2^IBCNEDST() ; IB*2.0*549 Added line
"RTN","IBCNEHLM",113,0)
S VNTE="NTE"_HLFS_"1"_HLFS_HLFS_IBPERSIST_HLREP_$TR(DSTAT,U,HLREP)
"RTN","IBCNEHLM",114,0)
S VNTE=VNTE_HLREP_RETRY_HLREP_TIMOUT ; IB*2.0*506
"RTN","IBCNEHLM",115,0)
S VNTE=VNTE_HLREP_$TR(DSTAT2,U,HLREP) ; IB*2.0*549 Added line
"RTN","IBCNEHLM",116,0)
S ^TMP("HLS",$J,4)=VNTE
"RTN","IBCNEHLM",117,0)
;
"RTN","IBCNEHLM",118,0)
D GENERATE^HLMA("IBCNE IIV REGISTER","GM",1,.HLRESLT,"")
"RTN","IBCNEHLM",119,0)
I $P(HLRESLT,U,2)]"" S HLRESLT="Error - "_$P(HLRESLT,U,2,99) D Q
"RTN","IBCNEHLM",120,0)
. S MSG(1)="HL7 eIV Registration Message not created."
"RTN","IBCNEHLM",121,0)
. S MSG(2)=HLRESLT
"RTN","IBCNEHLM",122,0)
. D MLMN
"RTN","IBCNEHLM",123,0)
K ^TMP("HLS",$J)
"RTN","IBCNEHLM",124,0)
Q
"RTN","IBCNEHLM",125,0)
;
"RTN","IBCNEHLM",126,0)
MLMN ; MailMan Message
"RTN","IBCNEHLM",127,0)
D TXT^IBCNEUT7("MSG")
"RTN","IBCNEHLM",128,0)
S XMSUB="eIV Registration Failure"
"RTN","IBCNEHLM",129,0)
D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
"RTN","IBCNEHLM",130,0)
K XMSUB,XMY,MSG,XMZ,XMDUZ
"RTN","IBCNEHLM",131,0)
Q
"RTN","IBCNEHLQ")
0^7^B108956868^B100204371
"RTN","IBCNEHLQ",1,0)
IBCNEHLQ ;DAOU/ALA - HL7 RQI Message ;17-JUN-2002
"RTN","IBCNEHLQ",2,0)
;;2.0;INTEGRATED BILLING;**184,271,300,361,416,438,467,497,533,516,601,621,631**;21-MAR-94;Build 11
"RTN","IBCNEHLQ",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHLQ",4,0)
;
"RTN","IBCNEHLQ",5,0)
;**Program Description**
"RTN","IBCNEHLQ",6,0)
; This routine builds an eIV Verification (RQI^I01) or
"RTN","IBCNEHLQ",7,0)
; Identification (RQI^I03) request
"RTN","IBCNEHLQ",8,0)
;
"RTN","IBCNEHLQ",9,0)
;**Modified by Date Reason
"RTN","IBCNEHLQ",10,0)
; DAOU/BHS 10/04/2002 Implementing Transmit SSN logic
"RTN","IBCNEHLQ",11,0)
; DAOU/DB 03/19/2004 Stripped dashes from SSN (PID, GT1)
"RTN","IBCNEHLQ",12,0)
;
"RTN","IBCNEHLQ",13,0)
EN ; Entry Point
"RTN","IBCNEHLQ",14,0)
; Variables
"RTN","IBCNEHLQ",15,0)
; HLFS = Field Separator
"RTN","IBCNEHLQ",16,0)
; DFN = Patient IEN
"RTN","IBCNEHLQ",17,0)
; PAYR = Payer IEN
"RTN","IBCNEHLQ",18,0)
; BUFF = Buffer IEN
"RTN","IBCNEHLQ",19,0)
; FRDT = Freshness Date
"RTN","IBCNEHLQ",20,0)
;
"RTN","IBCNEHLQ",21,0)
PID ; Patient Identification Segment
"RTN","IBCNEHLQ",22,0)
N VAFSTR,ICN,NM,I,PID11,EDQ,IBWHO,IBDOB,PID19
"RTN","IBCNEHLQ",23,0)
; IB*2.0*601
"RTN","IBCNEHLQ",24,0)
S VAFSTR=",1,7,8,11,",DFN=+$G(DFN) I $$MBICHK^IBCNEUT7(BUFF)!(EXT=4) S VAFSTR=VAFSTR_"19," ; IB*2.0*621 HAN
"RTN","IBCNEHLQ",25,0)
S PID=$$EN^VAFHLPID(DFN,VAFSTR,1)
"RTN","IBCNEHLQ",26,0)
S PID11=$P(PID,HLFS,12)
"RTN","IBCNEHLQ",27,0)
I PID11'="" D
"RTN","IBCNEHLQ",28,0)
. I $P(PID11,HLECH,1)="""""" S $P(PID11,HLECH,1)=""
"RTN","IBCNEHLQ",29,0)
. I $P(PID11,HLECH,2)="""""" S $P(PID11,HLECH,2)=""
"RTN","IBCNEHLQ",30,0)
. I $P(PID11,HLECH,3)="""""" S $P(PID11,HLECH,3)="UNKNOWN"
"RTN","IBCNEHLQ",31,0)
. S $P(PID,HLFS,12)=PID11
"RTN","IBCNEHLQ",32,0)
S PID19=$P(PID,HLFS,20)
"RTN","IBCNEHLQ",33,0)
; Encode special characters into Name and address pieces
"RTN","IBCNEHLQ",34,0)
; **NOTE: If $$EN^VAFHLPID should, in the future, return more than 11 pieces than the lines below may
"RTN","IBCNEHLQ",35,0)
; need to be modified as they currently expect 11 pieces to be returned.
"RTN","IBCNEHLQ",36,0)
I DFN D
"RTN","IBCNEHLQ",37,0)
.; try to get name of insured from NAME OF INSURED
"RTN","IBCNEHLQ",38,0)
.I ";1;5;6;7;"'[(";"_EXT_";"),$G(IRIEN)'="" D
"RTN","IBCNEHLQ",39,0)
.. S IBWHO=$P($G(^DPT(DFN,.312,IRIEN,0)),U,6)
"RTN","IBCNEHLQ",40,0)
.. I IBWHO'="",IBWHO'="v" Q
"RTN","IBCNEHLQ",41,0)
..;IB*2.0*601/DM for "self" appt extract, use patient's insurance insured DOB
"RTN","IBCNEHLQ",42,0)
.. S IBDOB=$$GET1^DIQ(2.312,IRIEN_","_DFN_",","INSURED'S DOB","I")
"RTN","IBCNEHLQ",43,0)
.. I IBDOB S $P(PID,HLFS,8)=$$HLDATE^HLFNC(IBDOB)
"RTN","IBCNEHLQ",44,0)
.. S NM=$P($G(^DPT(DFN,.312,IRIEN,7)),U,1)
"RTN","IBCNEHLQ",45,0)
.I ";1;5;6;7;"[(";"_EXT_";"),BUFF,$G(NM)="" D
"RTN","IBCNEHLQ",46,0)
.. S IBWHO=$P($G(^IBA(355.33,BUFF,60)),U,5)
"RTN","IBCNEHLQ",47,0)
.. I IBWHO'="",IBWHO'="v" Q
"RTN","IBCNEHLQ",48,0)
..;IB*2.0*601/DM for "self" buffer extract, use buff's insured DOB
"RTN","IBCNEHLQ",49,0)
..;otherwise, use patient's insurance insured DOB, otherwise use patient's DOB
"RTN","IBCNEHLQ",50,0)
.. S IBDOB=$$GET1^DIQ(355.33,BUFF_",","INSURED'S DOB","I")
"RTN","IBCNEHLQ",51,0)
.. I 'IBDOB,$G(IRIEN)'="" S IBDOB=$$GET1^DIQ(2.312,IRIEN_","_DFN_",","INSURED'S DOB","I")
"RTN","IBCNEHLQ",52,0)
.. I IBDOB S $P(PID,HLFS,8)=$$HLDATE^HLFNC(IBDOB)
"RTN","IBCNEHLQ",53,0)
.. S NM=$P($G(^IBA(355.33,BUFF,91)),U)
"RTN","IBCNEHLQ",54,0)
.I $G(NM)'="" S NM=$$HLNAME^HLFNC(NM,HLECH)
"RTN","IBCNEHLQ",55,0)
.; if unsuccessful, get patient name from 2/.01
"RTN","IBCNEHLQ",56,0)
.I $G(NM)="" D
"RTN","IBCNEHLQ",57,0)
..S NM("FILE")=2,NM("IENS")=DFN,NM("FIELD")=.01
"RTN","IBCNEHLQ",58,0)
..S NM=$$HLNAME^XLFNAME(.NM,"",$E(HLECH)),NM=$S(NM]"":NM,1:HLQ)
"RTN","IBCNEHLQ",59,0)
..Q
"RTN","IBCNEHLQ",60,0)
.S I=$L(NM,HLFS),NM=$$ENCHL7(NM),$P(PID,HLFS,6,5+I)=NM
"RTN","IBCNEHLQ",61,0)
.; IB*2.0*601
"RTN","IBCNEHLQ",62,0)
.S $P(PID,HLFS,20,99)=$$ENCHL7($P(PID,HLFS,20,99))
"RTN","IBCNEHLQ",63,0)
.S ICN=$P($G(^DPT(DFN,"MPI")),U,1)
"RTN","IBCNEHLQ",64,0)
.S $P(PID,HLFS,4)=ICN_HLECH_HLECH_HLECH_"USVHA"_HLECH_"NI"_HLECH_"~"_DFN_HLECH_HLECH_HLECH_"USVHA"_HLECH_"PI"_HLECH_$P($$SITE^VASITE,U,3)_HLECH
"RTN","IBCNEHLQ",65,0)
.Q
"RTN","IBCNEHLQ",66,0)
S FRDT=$$HLDATE^HLFNC($G(FRDT))
"RTN","IBCNEHLQ",67,0)
I PID19'="" S $P(PID,HLFS,13)="",$P(PID,HLFS,20)=PID19
"RTN","IBCNEHLQ",68,0)
I EXT'=4 S $P(PID,HLFS,34)=FRDT ; IB*2.0*621 Not for A1 transaction
"RTN","IBCNEHLQ",69,0)
Q
"RTN","IBCNEHLQ",70,0)
;
"RTN","IBCNEHLQ",71,0)
GT1 ; Guarantor Segment
"RTN","IBCNEHLQ",72,0)
N WHO,NM,IDOB,ISEX,SEX,RLIEN,PER,PLIEN,RDATA,IBSDATA,IBADDR
"RTN","IBCNEHLQ",73,0)
N EICDIIEN,IBFMIEN,IBTRKDTA ; IB*2.0*621/DM variables
"RTN","IBCNEHLQ",74,0)
;
"RTN","IBCNEHLQ",75,0)
S GT1=""
"RTN","IBCNEHLQ",76,0)
I $G(QUERY)="I" Q
"RTN","IBCNEHLQ",77,0)
;
"RTN","IBCNEHLQ",78,0)
; If the data was extracted from Buffer get specifics from Buffer file
"RTN","IBCNEHLQ",79,0)
I ";1;5;6;7;"[(";"_EXT_";") D
"RTN","IBCNEHLQ",80,0)
. S WHO=$P($G(^IBA(355.33,BUFF,60)),U,5)
"RTN","IBCNEHLQ",81,0)
. I WHO="v"!(WHO="") Q
"RTN","IBCNEHLQ",82,0)
. ;S NM=$P($G(^IBA(355.33,BUFF,60)),U,7),NM=$$NAME^IBCNEHLU(NM)
"RTN","IBCNEHLQ",83,0)
. S NM=$$GET1^DIQ(355.33,BUFF,91.01),NM=$$NAME^IBCNEHLU(NM) ;Get HIPAA data from new fields - IB*2*516
"RTN","IBCNEHLQ",84,0)
. S NM=$$HLNAME^HLFNC(NM,HLECH)
"RTN","IBCNEHLQ",85,0)
. S NM=$$ENCHL7(NM)
"RTN","IBCNEHLQ",86,0)
. S $P(GT1,HLFS,3)=NM_HLECH_HLECH_HLECH
"RTN","IBCNEHLQ",87,0)
. S IDOB=$P($G(^IBA(355.33,BUFF,60)),U,8),IDOB=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",88,0)
. S $P(GT1,HLFS,8)=IDOB
"RTN","IBCNEHLQ",89,0)
. S $P(GT1,HLFS,2)=$$SCRUB($G(SUBID))_HLECH_HLECH_HLECH_HLECH_"HC"
"RTN","IBCNEHLQ",90,0)
. Q
"RTN","IBCNEHLQ",91,0)
;
"RTN","IBCNEHLQ",92,0)
; If the data was from the appointment extract, check Patient file, IB*2.0*621/DM
"RTN","IBCNEHLQ",93,0)
I EXT=2 D
"RTN","IBCNEHLQ",94,0)
. I IRIEN="" Q
"RTN","IBCNEHLQ",95,0)
. S WHO=$P($G(^DPT(DFN,.312,IRIEN,0)),U,6)
"RTN","IBCNEHLQ",96,0)
. I WHO="v"!(WHO="") Q
"RTN","IBCNEHLQ",97,0)
. ;S NM=$P($G(^DPT(DFN,.312,IRIEN,0)),U,17) ; WCJ;IB*2.0*497
"RTN","IBCNEHLQ",98,0)
. S NM=$P($G(^DPT(DFN,.312,IRIEN,7)),U,1) ; WCJ;IB*2.0*497
"RTN","IBCNEHLQ",99,0)
. S NM=$$HLNAME^HLFNC(NM,HLECH)
"RTN","IBCNEHLQ",100,0)
. S NM=$$ENCHL7(NM)
"RTN","IBCNEHLQ",101,0)
. S $P(GT1,HLFS,3)=NM_HLECH_HLECH_HLECH
"RTN","IBCNEHLQ",102,0)
. S IDOB=$P($G(^DPT(DFN,.312,IRIEN,3)),U,1),IDOB=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",103,0)
. S $P(GT1,HLFS,8)=IDOB
"RTN","IBCNEHLQ",104,0)
. S $P(GT1,HLFS,2)=$$SCRUB($G(SUBID))_HLECH_HLECH_HLECH_HLECH_"HC"
"RTN","IBCNEHLQ",105,0)
. ;
"RTN","IBCNEHLQ",106,0)
. S IBSDATA=$G(^DPT(DFN,.312,IRIEN,3))
"RTN","IBCNEHLQ",107,0)
. S IBADDR=$$HLADDR^HLFNC($P(IBSDATA,U,6,7),$P(IBSDATA,U,8,10))
"RTN","IBCNEHLQ",108,0)
. S $P(GT1,HLFS,5)=$$ENCHL7(IBADDR)
"RTN","IBCNEHLQ",109,0)
. ;
"RTN","IBCNEHLQ",110,0)
. D CHK
"RTN","IBCNEHLQ",111,0)
. I $P(GT1,HLFS,8)=""&(IDOB'="") S $P(GT1,HLFS,8)=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",112,0)
. I $P(GT1,HLFS,9)=""&(ISEX'="") S $P(GT1,HLFS,9)=ISEX
"RTN","IBCNEHLQ",113,0)
. I $P(GT1,HLFS,9)="",WHO="s" D
"RTN","IBCNEHLQ",114,0)
.. S SEX=$P($G(^DPT(DFN,.312,IRIEN,3)),U,12) ; get policy holder sex
"RTN","IBCNEHLQ",115,0)
.. I SEX="" S SEX=$P(^DPT(DFN,0),U,2),SEX=$S(SEX="M":"F",1:"M") ; if null, use alternative method
"RTN","IBCNEHLQ",116,0)
.. S $P(GT1,HLFS,9)=SEX
"RTN","IBCNEHLQ",117,0)
;
"RTN","IBCNEHLQ",118,0)
; IB*2.0*621/DM add EICD Verification, use data from EIV EICD TRACKING (#365.18)
"RTN","IBCNEHLQ",119,0)
I EXT=4,$G(QUERY)="V" D
"RTN","IBCNEHLQ",120,0)
. S EICDIIEN=+$O(^IBCN(365.18,"C",IEN,0)) ; IEN is the TQ from IBCNEDEP
"RTN","IBCNEHLQ",121,0)
. I ('EICDIIEN)!(EICDVIEN="") Q
"RTN","IBCNEHLQ",122,0)
. S IBFMIEN=EICDVIEN_","_EICDIIEN_","
"RTN","IBCNEHLQ",123,0)
. K IBTRKDTA D GETS^DIQ(365.185,IBFMIEN,".04;.07;.08;.09","I","IBTRKDTA") ; grab selected fields (internal)
"RTN","IBCNEHLQ",124,0)
. ;
"RTN","IBCNEHLQ",125,0)
. S NM=IBTRKDTA(365.185,IBFMIEN,.09,"I")
"RTN","IBCNEHLQ",126,0)
. Q:NM="" ; no name means subscriber -- GT1 is not needed
"RTN","IBCNEHLQ",127,0)
. S NM=$$HLNAME^HLFNC(NM,HLECH)
"RTN","IBCNEHLQ",128,0)
. S NM=$$ENCHL7(NM)
"RTN","IBCNEHLQ",129,0)
. S $P(GT1,HLFS,3)=NM_HLECH_HLECH_HLECH
"RTN","IBCNEHLQ",130,0)
. S IDOB=IBTRKDTA(365.185,IBFMIEN,.07,"I"),IDOB=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",131,0)
. S $P(GT1,HLFS,8)=IDOB
"RTN","IBCNEHLQ",132,0)
. ; Subscriber ID -- Guarantor Number
"RTN","IBCNEHLQ",133,0)
. S $P(GT1,HLFS,2)=$$SCRUB(IBTRKDTA(365.185,IBFMIEN,.04,"I"))_HLECH_HLECH_HLECH_HLECH_"HC"
"RTN","IBCNEHLQ",134,0)
. ; skip address data
"RTN","IBCNEHLQ",135,0)
. S ISEX=IBTRKDTA(365.185,IBFMIEN,.08,"I")
"RTN","IBCNEHLQ",136,0)
. I $P(GT1,HLFS,8)=""&(IDOB'="") S $P(GT1,HLFS,8)=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",137,0)
. I $P(GT1,HLFS,9)=""&(ISEX'="") S $P(GT1,HLFS,9)=ISEX
"RTN","IBCNEHLQ",138,0)
;
"RTN","IBCNEHLQ",139,0)
I GT1="" Q
"RTN","IBCNEHLQ",140,0)
S $P(GT1,HLFS,1)=1
"RTN","IBCNEHLQ",141,0)
S GT1="GT1"_HLFS_GT1
"RTN","IBCNEHLQ",142,0)
Q
"RTN","IBCNEHLQ",143,0)
;
"RTN","IBCNEHLQ",144,0)
IN1 ; Insurance Segment
"RTN","IBCNEHLQ",145,0)
N EFFDT,ELIGDT,EXPDT,PREL,ADMN,ADMDT,IENS
"RTN","IBCNEHLQ",146,0)
N EICDIIEN,IBFMIEN,IBPYIEN,IBTRKDTA ; IB*2.0*621/DM variables
"RTN","IBCNEHLQ",147,0)
S IN1=""
"RTN","IBCNEHLQ",148,0)
;
"RTN","IBCNEHLQ",149,0)
; If the data was extracted from Buffer get specifics from Buffer file
"RTN","IBCNEHLQ",150,0)
I ";1;5;6;7;"[(";"_EXT_";") D
"RTN","IBCNEHLQ",151,0)
.S PREL=$P($G(^IBA(355.33,BUFF,60)),U,14)
"RTN","IBCNEHLQ",152,0)
.S ELIGDT=$P($G(TRANSR),U,12) I ELIGDT=DT S ELIGDT=""
"RTN","IBCNEHLQ",153,0)
.S $P(IN1,HLFS,2)=$S(PREL=18:$$SCRUB($G(SUBID)),PREL="":$$SCRUB($G(SUBID)),1:$$SCRUB($G(PATID)))
"RTN","IBCNEHLQ",154,0)
.I PAYR'=$$FIND1^DIC(365.12,"","X","~NO PAYER") D
"RTN","IBCNEHLQ",155,0)
..S $P(IN1,HLFS,3)=$$ENCHL7($P(^IBE(365.12,PAYR,0),U,2))_HLECH_HLECH_HLECH_"USVHA"_HLECH_"VP"_HLECH
"RTN","IBCNEHLQ",156,0)
..S $P(IN1,HLFS,4)=$$ENCHL7($P(^IBE(365.12,PAYR,0),U,1))
"RTN","IBCNEHLQ",157,0)
. ;IB*2.0*516/TAZ - Use HIPAA compliant fields
"RTN","IBCNEHLQ",158,0)
.;S $P(IN1,HLFS,8)=$$ENCHL7($P($G(^IBA(355.33,BUFF,40)),U,3))
"RTN","IBCNEHLQ",159,0)
.;S $P(IN1,HLFS,9)=$$ENCHL7($P($G(^IBA(355.33,BUFF,40)),U,2))
"RTN","IBCNEHLQ",160,0)
.S $P(IN1,HLFS,8)=$$ENCHL7($$GET1^DIQ(355.33,BUFF_",",90.02))
"RTN","IBCNEHLQ",161,0)
.S $P(IN1,HLFS,9)=$$ENCHL7($$GET1^DIQ(355.33,BUFF_",",90.01))
"RTN","IBCNEHLQ",162,0)
.S EFFDT=$P($G(^IBA(355.33,BUFF,60)),U,2),EFFDT=$$HLDATE^HLFNC(EFFDT)
"RTN","IBCNEHLQ",163,0)
.S EXPDT=$P($G(^IBA(355.33,BUFF,60)),U,3),EXPDT=$$HLDATE^HLFNC(EXPDT)
"RTN","IBCNEHLQ",164,0)
.S $P(IN1,HLFS,12)=EFFDT
"RTN","IBCNEHLQ",165,0)
.S $P(IN1,HLFS,13)=EXPDT
"RTN","IBCNEHLQ",166,0)
.S $P(IN1,HLFS,17)=$$PATREL(PREL)
"RTN","IBCNEHLQ",167,0)
.S $P(IN1,HLFS,26)=$$HLDATE^HLFNC(ELIGDT)
"RTN","IBCNEHLQ",168,0)
.I $P(IN1,HLFS,17)="" S $P(IN1,HLFS,17)=18
"RTN","IBCNEHLQ",169,0)
;
"RTN","IBCNEHLQ",170,0)
; If the data was from the appointment extract, check Patient file, IB*2.0*621/DM
"RTN","IBCNEHLQ",171,0)
I EXT=2 D
"RTN","IBCNEHLQ",172,0)
. I IRIEN="" Q
"RTN","IBCNEHLQ",173,0)
. I $$SCRUB($G(SUBID))'=$$SCRUB($P($G(^DPT(DFN,.312,IRIEN,0)),U,2)) Q
"RTN","IBCNEHLQ",174,0)
. S EFFDT=$P($G(^DPT(DFN,.312,IRIEN,0)),U,8),EFFDT=$$HLDATE^HLFNC(EFFDT)
"RTN","IBCNEHLQ",175,0)
. S EXPDT=$P($G(^DPT(DFN,.312,IRIEN,0)),U,4),EXPDT=$$HLDATE^HLFNC(EXPDT)
"RTN","IBCNEHLQ",176,0)
. S $P(IN1,HLFS,12)=EFFDT
"RTN","IBCNEHLQ",177,0)
. S $P(IN1,HLFS,13)=EXPDT
"RTN","IBCNEHLQ",178,0)
. S PREL=$P($G(^DPT(DFN,.312,IRIEN,4)),U,3)
"RTN","IBCNEHLQ",179,0)
. S $P(IN1,HLFS,2)=$S(PREL=18:$$SCRUB($G(SUBID)),PREL="":$$SCRUB($G(SUBID)),1:$$SCRUB($G(PATID)))
"RTN","IBCNEHLQ",180,0)
. I PAYR'=$$FIND1^DIC(365.12,"","X","~NO PAYER") D
"RTN","IBCNEHLQ",181,0)
.. S $P(IN1,HLFS,3)=$$ENCHL7($P(^IBE(365.12,PAYR,0),U,2))_HLECH_HLECH_HLECH_"USVHA"_HLECH_"VP"_HLECH
"RTN","IBCNEHLQ",182,0)
.. S $P(IN1,HLFS,4)=$$ENCHL7($P(^IBE(365.12,PAYR,0),U,1))
"RTN","IBCNEHLQ",183,0)
. S $P(IN1,HLFS,17)=$$PATREL(PREL)
"RTN","IBCNEHLQ",184,0)
. S IENS=IRIEN_","_DFN_","
"RTN","IBCNEHLQ",185,0)
. S $P(IN1,HLFS,8)=$$ENCHL7($$GET1^DIQ(2.312,IENS,21,"E"))
"RTN","IBCNEHLQ",186,0)
. S $P(IN1,HLFS,9)=$$ENCHL7($$GET1^DIQ(2.312,IENS,20,"E"))
"RTN","IBCNEHLQ",187,0)
. I $P(IN1,HLFS,17)="" S $P(IN1,HLFS,17)=18
"RTN","IBCNEHLQ",188,0)
;
"RTN","IBCNEHLQ",189,0)
; IB*2.0*621/DM add EICD Verification, use data from EIV EICD TRACKING (#365.18)
"RTN","IBCNEHLQ",190,0)
I EXT=4,$G(QUERY)="V" D
"RTN","IBCNEHLQ",191,0)
. S EICDIIEN=+$O(^IBCN(365.18,"C",IEN,0)) ; IEN is the TQ from IBCNEDEP
"RTN","IBCNEHLQ",192,0)
. I ('EICDIIEN)!(EICDVIEN="") Q
"RTN","IBCNEHLQ",193,0)
. S IBFMIEN=EICDVIEN_","_EICDIIEN_","
"RTN","IBCNEHLQ",194,0)
. K IBTRKDTA D GETS^DIQ(365.185,IBFMIEN,".01;.03;.05;.09","I","IBTRKDTA") ; grab selected fields (internal)
"RTN","IBCNEHLQ",195,0)
. ;
"RTN","IBCNEHLQ",196,0)
. S PREL="18" ; means self/veteran
"RTN","IBCNEHLQ",197,0)
. S:IBTRKDTA(365.185,IBFMIEN,.09,"I")'="" PREL="" ; not subscriber
"RTN","IBCNEHLQ",198,0)
. S $P(IN1,HLFS,2)=IBTRKDTA(365.185,IBFMIEN,.05,"I")
"RTN","IBCNEHLQ",199,0)
. S $P(IN1,HLFS,3)=$$ENCHL7(IBTRKDTA(365.185,IBFMIEN,.01,"I"))_HLECH_HLECH_HLECH_"USVHA"_HLECH_"VP"_HLECH ; PAYER VA ID
"RTN","IBCNEHLQ",200,0)
. S IBPYIEN=+$$FIND1^DIC(365.12,,"QX",IBTRKDTA(365.185,IBFMIEN,.01,"I"),"C") ; PAYER IEN
"RTN","IBCNEHLQ",201,0)
. S $P(IN1,HLFS,4)=$$ENCHL7($$GET1^DIQ(365.12,IBPYIEN_",",.01)) ; PAYER NAME
"RTN","IBCNEHLQ",202,0)
. S $P(IN1,HLFS,17)=$$PATREL(PREL)
"RTN","IBCNEHLQ",203,0)
. S $P(IN1,HLFS,8)=IBTRKDTA(365.185,IBFMIEN,.03,"I") ; GROUP NUMBER
"RTN","IBCNEHLQ",204,0)
I IN1="" Q
"RTN","IBCNEHLQ",205,0)
;
"RTN","IBCNEHLQ",206,0)
S $P(IN1,HLFS,1)=1
"RTN","IBCNEHLQ",207,0)
S IN1="IN1"_HLFS_IN1
"RTN","IBCNEHLQ",208,0)
Q
"RTN","IBCNEHLQ",209,0)
;
"RTN","IBCNEHLQ",210,0)
NTE(CTR) ; NTE Segment
"RTN","IBCNEHLQ",211,0)
N EICDIIEN
"RTN","IBCNEHLQ",212,0)
; TRANSR is 0 node of TQ, set in PROC^IBCNEDEP
"RTN","IBCNEHLQ",213,0)
I CTR=1 S NTE=$$EXTERNAL^DILFD(365.1,.2,,$P($G(TRANSR),U,20)) ; service code from 365.1/.2
"RTN","IBCNEHLQ",214,0)
; IB*2.0*601 - Added NTE2 and NTE3
"RTN","IBCNEHLQ",215,0)
I CTR=2 D
"RTN","IBCNEHLQ",216,0)
. S NTE=$$GET1^DIQ(365.1,IEN_",","SOURCE OF INFORMATION","I") ; IEN = ien of TQ
"RTN","IBCNEHLQ",217,0)
. S NTE=$$GET1^DIQ(355.12,NTE_",","IB BUFFER ACRONYM")
"RTN","IBCNEHLQ",218,0)
; IB*2.0*631/TAZ restructure NTE(3)
"RTN","IBCNEHLQ",219,0)
I CTR=3 D
"RTN","IBCNEHLQ",220,0)
. N TYPE,WHICH
"RTN","IBCNEHLQ",221,0)
. S NTE=$S(((EXT=4)&(QUERY="I")):"OHI",$$MBICHK^IBCNEUT7(BUFF):"MBI",1:"ELI") ; IB*2.0*621
"RTN","IBCNEHLQ",222,0)
. S WHICH=$$GET1^DIQ(365.1,IEN_",",.1,"I") ;WHICH EXTRACT
"RTN","IBCNEHLQ",223,0)
. S TYPE="" D
"RTN","IBCNEHLQ",224,0)
.. I $$GET1^DIQ(365.1,IEN_",",.04)="Retry" S TYPE="RETRY" Q
"RTN","IBCNEHLQ",225,0)
.. I WHICH=1 S TYPE="BUFFER" Q
"RTN","IBCNEHLQ",226,0)
.. I WHICH=2 S TYPE="APPT" Q
"RTN","IBCNEHLQ",227,0)
.. I WHICH=3 S TYPE="NON-VERIFIED" Q
"RTN","IBCNEHLQ",228,0)
.. I EXT=4 D Q
"RTN","IBCNEHLQ",229,0)
... I QUERY="I" S TYPE="EICD-I" Q
"RTN","IBCNEHLQ",230,0)
... S TYPE="EICD-V"
"RTN","IBCNEHLQ",231,0)
.. I WHICH=5 S TYPE="REQUEST ELECTRONIC" Q
"RTN","IBCNEHLQ",232,0)
.. I WHICH=6 S TYPE="ICB/VISTA" Q
"RTN","IBCNEHLQ",233,0)
.. I WHICH=7 S TYPE="MBI REQUEST"
"RTN","IBCNEHLQ",234,0)
. S NTE=NTE_"~"_TYPE
"RTN","IBCNEHLQ",235,0)
; IB*2.0*621
"RTN","IBCNEHLQ",236,0)
I CTR=4 S NTE="" ; Reporting of known insurance information will happen at a later release
"RTN","IBCNEHLQ",237,0)
I CTR=5 S NTE=""
"RTN","IBCNEHLQ",238,0)
I CTR=5,EXT=4,QUERY="V" D
"RTN","IBCNEHLQ",239,0)
. ; on EICD Verifications, pass the TRACE # from the associated EICD Inquiry
"RTN","IBCNEHLQ",240,0)
. S EICDIIEN=+$O(^IBCN(365.18,"C",IEN,0)) ; IEN is the TQ from IBCNEDEP
"RTN","IBCNEHLQ",241,0)
. S NTE=$$GET1^DIQ(365.18,EICDIIEN_",",.04,"I") ; EICD TRACE NUMBER
"RTN","IBCNEHLQ",242,0)
S NTE="NTE"_HLFS_CTR_HLFS_HLFS_NTE
"RTN","IBCNEHLQ",243,0)
K CTR
"RTN","IBCNEHLQ",244,0)
Q
"RTN","IBCNEHLQ",245,0)
;
"RTN","IBCNEHLQ",246,0)
CHK ; Check for spouse or other information in the Patient Relation File
"RTN","IBCNEHLQ",247,0)
; DGREL = Relationship (1=Self, 2=Spouse, 3-34,99=Other)
"RTN","IBCNEHLQ",248,0)
NEW IEN,QFL
"RTN","IBCNEHLQ",249,0)
S IEN="",RLIEN="",ISEX="",QFL=0
"RTN","IBCNEHLQ",250,0)
F S IEN=$O(^DGPR(408.12,"B",DFN,IEN)) Q:IEN="" D Q:QFL
"RTN","IBCNEHLQ",251,0)
. S DGREL=$P($G(^DGPR(408.12,IEN,0)),U,2)
"RTN","IBCNEHLQ",252,0)
. ;
"RTN","IBCNEHLQ",253,0)
. ; If person is veteran, quit
"RTN","IBCNEHLQ",254,0)
. I DGREL=1 Q
"RTN","IBCNEHLQ",255,0)
. ;
"RTN","IBCNEHLQ",256,0)
. ; If person is spouse, pick that record and quit
"RTN","IBCNEHLQ",257,0)
. I WHO="s",DGREL=2 S RLIEN=IEN,QFL=1 Q
"RTN","IBCNEHLQ",258,0)
. ;
"RTN","IBCNEHLQ",259,0)
. ; Otherwise it should be an 'other' dependent
"RTN","IBCNEHLQ",260,0)
. S RLIEN=IEN
"RTN","IBCNEHLQ",261,0)
;
"RTN","IBCNEHLQ",262,0)
I RLIEN="" Q
"RTN","IBCNEHLQ",263,0)
;
"RTN","IBCNEHLQ",264,0)
; Check for Sex, SSN, DOB in INCOME PERSON File
"RTN","IBCNEHLQ",265,0)
S PER=$P(^DGPR(408.12,RLIEN,0),U,3)
"RTN","IBCNEHLQ",266,0)
I PER'["DGPR(408.13" Q
"RTN","IBCNEHLQ",267,0)
S PLIEN=$P(PER,";",1)
"RTN","IBCNEHLQ",268,0)
I PLIEN="" Q
"RTN","IBCNEHLQ",269,0)
S RDATA=$G(^DGPR(408.13,PLIEN,0)),ISEX=$P(RDATA,U,2),IDOB=$P(RDATA,U,3)
"RTN","IBCNEHLQ",270,0)
I $P(RDATA,U,4)'="" N DFN S DFN=$P(RDATA,U,4),ISEX=$P(^DPT(DFN,0),U,2),IDOB=$P(^DPT(DFN,0),U,3)
"RTN","IBCNEHLQ",271,0)
Q
"RTN","IBCNEHLQ",272,0)
;
"RTN","IBCNEHLQ",273,0)
ENCHL7(STR) ; Encode HL7 escape seqs in data fields
"RTN","IBCNEHLQ",274,0)
;
"RTN","IBCNEHLQ",275,0)
; Input:
"RTN","IBCNEHLQ",276,0)
; STR = Field data possible containing HL7 encoding chars
"RTN","IBCNEHLQ",277,0)
;
"RTN","IBCNEHLQ",278,0)
; Output Values
"RTN","IBCNEHLQ",279,0)
; Fn returns string w/converted escape seqs
"RTN","IBCNEHLQ",280,0)
;
"RTN","IBCNEHLQ",281,0)
N CHR,NEW,RPLC,CNT,LOOP
"RTN","IBCNEHLQ",282,0)
;
"RTN","IBCNEHLQ",283,0)
; Replace "\" "&" "~" "|" with \F\ \R\ \E\ \T\ respectively
"RTN","IBCNEHLQ",284,0)
F CHR="\","&","~","|" S CNT=$L(STR,CHR) I CNT>1 D
"RTN","IBCNEHLQ",285,0)
. S NEW=$P(STR,CHR)
"RTN","IBCNEHLQ",286,0)
. S RPLC="\"_$TR(CHR,"|~\&","FRET")_"\"
"RTN","IBCNEHLQ",287,0)
. F LOOP=2:1:CNT S NEW=NEW_RPLC_$P(STR,CHR,LOOP)
"RTN","IBCNEHLQ",288,0)
. S STR=NEW
"RTN","IBCNEHLQ",289,0)
;
"RTN","IBCNEHLQ",290,0)
Q STR
"RTN","IBCNEHLQ",291,0)
;
"RTN","IBCNEHLQ",292,0)
SCRUB(Z) ; remove all punctuation from the string and convert lowercase to uppercase
"RTN","IBCNEHLQ",293,0)
; IB*2*416 - used for subscriber and patient ID fields
"RTN","IBCNEHLQ",294,0)
S Z=$$NOPUNCT^IBCEF(Z,1)
"RTN","IBCNEHLQ",295,0)
S Z=$$UP^XLFSTR(Z)
"RTN","IBCNEHLQ",296,0)
SCRUBX ;
"RTN","IBCNEHLQ",297,0)
Q Z
"RTN","IBCNEHLQ",298,0)
;
"RTN","IBCNEHLQ",299,0)
PATREL(REL) ; convert pat.relationship to insured from VistA to X12 and return X12 value
"RTN","IBCNEHLQ",300,0)
; REL - VistA value
"RTN","IBCNEHLQ",301,0)
;
"RTN","IBCNEHLQ",302,0)
; VistA values of Self (18), Spouse (01), and Child (19) remain unchanged,
"RTN","IBCNEHLQ",303,0)
; anything else is converted to X12 value of Other Adult (34)
"RTN","IBCNEHLQ",304,0)
;
"RTN","IBCNEHLQ",305,0)
Q $S($G(REL)="":"",".01.18.19."[("."_REL_"."):REL,1:34)
"RTN","IBCNEMS1")
0^12^B11188278^B7021261
"RTN","IBCNEMS1",1,0)
IBCNEMS1 ;AITC/DM - Consolidated Mailman messages; 12-JUNE-2018
"RTN","IBCNEMS1",2,0)
;;2.0;INTEGRATED BILLING;**621,631**;21-MAR-94;Build 11
"RTN","IBCNEMS1",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEMS1",4,0)
;
"RTN","IBCNEMS1",5,0)
;
"RTN","IBCNEMS1",6,0)
; These routines are being consolidated in one area for ease in maintenance
"RTN","IBCNEMS1",7,0)
; The calling routine is responsible for setting the target MAILGROUP, Subject text
"RTN","IBCNEMS1",8,0)
; and finally calling MSG^IBCNEUT5(...) to send the actual Mailman message
"RTN","IBCNEMS1",9,0)
;
"RTN","IBCNEMS1",10,0)
MSG001(MSG,EXNAME) ; error msg for $$SDAPI^SDAMA301 appointment api issue from an extract
"RTN","IBCNEMS1",11,0)
; MSG is the global that will be populated with message text.
"RTN","IBCNEMS1",12,0)
; EXNAME is the extract that had the issue (e.g. "EICD")
"RTN","IBCNEMS1",13,0)
; It is assumed that ^TMP($J,"SDAMA301") has been populated by the failed call
"RTN","IBCNEMS1",14,0)
;
"RTN","IBCNEMS1",15,0)
N IBMSG,IBII
"RTN","IBCNEMS1",16,0)
S MSG(1)="On "_$$FMTE^XLFDT(DT)_" the "_EXNAME_" Extract for eIV encountered"
"RTN","IBCNEMS1",17,0)
S MSG(2)="one or more errors while attempting to get Appointment data"
"RTN","IBCNEMS1",18,0)
S MSG(3)="from the scheduling package."
"RTN","IBCNEMS1",19,0)
S MSG(4)=""
"RTN","IBCNEMS1",20,0)
S MSG(5)="Error(s) encountered: "
"RTN","IBCNEMS1",21,0)
S MSG(6)=""
"RTN","IBCNEMS1",22,0)
S MSG(7)=" Error Code Error Message"
"RTN","IBCNEMS1",23,0)
S MSG(8)=" ---------- -------------"
"RTN","IBCNEMS1",24,0)
S IBMSG=8,IBII=0
"RTN","IBCNEMS1",25,0)
F S IBII=$O(^TMP($J,"SDAMA301",IBII)) Q:IBII="" S IBMSG=IBMSG+1,MSG(IBMSG)=" "_$$LJ^XLFSTR(IBII,13)_$G(^TMP($J,"SDAMA301",IBII))
"RTN","IBCNEMS1",26,0)
S IBMSG=IBMSG+1,MSG(IBMSG)=""
"RTN","IBCNEMS1",27,0)
S IBMSG=IBMSG+1,MSG(IBMSG)="As a result of this error the extract was not done. The extract"
"RTN","IBCNEMS1",28,0)
S IBMSG=IBMSG+1,MSG(IBMSG)="will be attempted again the next night automatically. If you"
"RTN","IBCNEMS1",29,0)
S IBMSG=IBMSG+1,MSG(IBMSG)="continue to receive error messages you should contact your IRM"
"RTN","IBCNEMS1",30,0)
S IBMSG=IBMSG+1,MSG(IBMSG)="and possibly call the Help Desk for assistance."
"RTN","IBCNEMS1",31,0)
;
"RTN","IBCNEMS1",32,0)
Q
"RTN","IBCNEMS1",33,0)
;
"RTN","IBCNEMS1",34,0)
MSG002(MSG,ERRGB,TQ) ; error msg when writing to EIV EICD TRACKING (#365.18) from IBCNEDE4
"RTN","IBCNEMS1",35,0)
; MSG is the global that will be populated with message text.
"RTN","IBCNEMS1",36,0)
; ERRBG is the ERROR global that was passed to a Fileman ^DIE call
"RTN","IBCNEMS1",37,0)
; TQ IEN of the associated IIV Transmission Queue
"RTN","IBCNEMS1",38,0)
; The user should verify that there is an existing error before making this call
"RTN","IBCNEMS1",39,0)
; Set to IB site parameter MAILGROUP
"RTN","IBCNEMS1",40,0)
;
"RTN","IBCNEMS1",41,0)
S MSG(1)="Tried to create an entry in the EIV EICD TRACKING file #365.18"
"RTN","IBCNEMS1",42,0)
S MSG(2)="without success."
"RTN","IBCNEMS1",43,0)
S MSG(3)=""
"RTN","IBCNEMS1",44,0)
S MSG(4)="Error encountered: "_$G(ERRGB("DIERR",1,"TEXT",1))
"RTN","IBCNEMS1",45,0)
S MSG(5)=""
"RTN","IBCNEMS1",46,0)
S MSG(6)="The associated IIV Transmission Queue IEN: "_TQ
"RTN","IBCNEMS1",47,0)
S MSG(7)=""
"RTN","IBCNEMS1",48,0)
S MSG(8)="If you continue to receive this error message, you should contact"
"RTN","IBCNEMS1",49,0)
S MSG(9)="your IRM and possibly call the Help Desk for assistance."
"RTN","IBCNEMS1",50,0)
Q
"RTN","IBCNEMS1",51,0)
;
"RTN","IBCNEMS1",52,0)
MSG003(MSG,ERRGB,TQN,RESP,BUFF) ; Create and send a response processing error warning message
"RTN","IBCNEMS1",53,0)
; Output Variables
"RTN","IBCNEMS1",54,0)
; ERFLG=1
"RTN","IBCNEMS1",55,0)
;
"RTN","IBCNEMS1",56,0)
S MSG(1)="Tried to create an entry in the CREATION TO PROCESSING TRACKING file #355.36"
"RTN","IBCNEMS1",57,0)
S MSG(2)="without success."
"RTN","IBCNEMS1",58,0)
S MSG(3)=""
"RTN","IBCNEMS1",59,0)
S MSG(4)="Error encountered: "_$G(ERRGB("DIERR",1,"TEXT",1))
"RTN","IBCNEMS1",60,0)
S MSG(5)=""
"RTN","IBCNEMS1",61,0)
S MSG(6)="The associated IIV Transmission Queue IEN: "_$G(TQN)
"RTN","IBCNEMS1",62,0)
S MSG(7)="The associated IIV Repsonse IEN: "_$G(RESP)
"RTN","IBCNEMS1",63,0)
S MSG(8)="The associated INSURANCE VERIFICATION PROCESSOR IEN: "_$G(BUFF)
"RTN","IBCNEMS1",64,0)
S MSG(9)=""
"RTN","IBCNEMS1",65,0)
S MSG(10)="If you continue to receive this error message, you should contact"
"RTN","IBCNEMS1",66,0)
S MSG(11)="your IRM and possibly call the Help Desk for assistance."
"RTN","IBCNEMS1",67,0)
Q
"RTN","IBCNEMS1",68,0)
;
"RTN","IBCNEQU")
0^5^B176309456^B176017271
"RTN","IBCNEQU",1,0)
IBCNEQU ;DAOU/BHS - eIV REQUEST ELECTRONIC INSURANCE INQUIRY ;24-JUN-2002
"RTN","IBCNEQU",2,0)
;;2.0;INTEGRATED BILLING;**184,271,416,438,497,582,601,631**;21-MAR-94;Build 11
"RTN","IBCNEQU",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEQU",4,0)
;
"RTN","IBCNEQU",5,0)
; eIV - Insurance Verification Interface
"RTN","IBCNEQU",6,0)
;
"RTN","IBCNEQU",7,0)
; Must call from EN
"RTN","IBCNEQU",8,0)
Q
"RTN","IBCNEQU",9,0)
;
"RTN","IBCNEQU",10,0)
EN ; Entry pt
"RTN","IBCNEQU",11,0)
; Init vars
"RTN","IBCNEQU",12,0)
N DFN,X,POP,IBFASTXT,VALMCNT,VALMBG,VALMHDR,VALMBCK,IDUZ
"RTN","IBCNEQU",13,0)
;
"RTN","IBCNEQU",14,0)
EN1 I $G(IBFASTXT) G ENX
"RTN","IBCNEQU",15,0)
S DFN=$$PAT I 'DFN G ENX
"RTN","IBCNEQU",16,0)
D EN^VALM("IBCNE REQUEST INS INQUIRY LIST")
"RTN","IBCNEQU",17,0)
G EN1
"RTN","IBCNEQU",18,0)
;
"RTN","IBCNEQU",19,0)
ENX ; EN exit pt
"RTN","IBCNEQU",20,0)
Q
"RTN","IBCNEQU",21,0)
;
"RTN","IBCNEQU",22,0)
INIT ; -- set up initial variables
"RTN","IBCNEQU",23,0)
S VALMCNT=0,VALMBG=1,IDUZ=DUZ
"RTN","IBCNEQU",24,0)
K ^TMP("IBCNEQU",$J),^TMP("IBCNEQUX",$J),^TMP("IBCNEQUDTS",$J)
"RTN","IBCNEQU",25,0)
D HDR
"RTN","IBCNEQU",26,0)
D BLD(DFN)
"RTN","IBCNEQU",27,0)
;
"RTN","IBCNEQU",28,0)
INITX ; INIT exit pt
"RTN","IBCNEQU",29,0)
Q
"RTN","IBCNEQU",30,0)
;
"RTN","IBCNEQU",31,0)
HDR ; -- screen header for initial screen
"RTN","IBCNEQU",32,0)
N VA,VAERR,%DT,II
"RTN","IBCNEQU",33,0)
D PID^VADPT
"RTN","IBCNEQU",34,0)
S VALMHDR(1)="Request Electronic Insurance Inquiry for Patient: "_$E($P($G(^DPT(DFN,0)),U),1,20)_" "_$E($G(^(0)),1)_VA("BID")
"RTN","IBCNEQU",35,0)
S VALMHDR(2)=" "
"RTN","IBCNEQU",36,0)
S VALMHDR(3)=" "
"RTN","IBCNEQU",37,0)
S II=1
"RTN","IBCNEQU",38,0)
I +$$BUFFER^IBCNBU1(DFN) S II=II+1,VALMHDR(II)="*** Patient has Insurance Buffer Records"
"RTN","IBCNEQU",39,0)
I $P($G(^DPT(DFN,.35)),U)'="" S II=II+1,VALMHDR(II)="*** Date of Death: "_$$FMTE^XLFDT($P($G(^DPT(DFN,.35)),U)\1,"5Z")
"RTN","IBCNEQU",40,0)
Q
"RTN","IBCNEQU",41,0)
;
"RTN","IBCNEQU",42,0)
HELP ; -- help code
"RTN","IBCNEQU",43,0)
D FULL^VALM1
"RTN","IBCNEQU",44,0)
W @IOF
"RTN","IBCNEQU",45,0)
W !,"When requesting an Electronic Insurance Inquiry..." ; IB*2*601/DM
"RTN","IBCNEQU",46,0)
W !,"This screen lists all eligible (non-Medicaid) Insurance policies"
"RTN","IBCNEQU",47,0)
W !,"for the patient. Selecting an entry in this list creates an Insurance Buffer"
"RTN","IBCNEQU",48,0)
W !,"entry with Source 'eIV' and Override Freshness Flag 'Yes'. Setting this flag"
"RTN","IBCNEQU",49,0)
W !,"is designed to force the eIV extract to attempt to create an insurance"
"RTN","IBCNEQU",50,0)
W !,"inquiry based on this entry."
"RTN","IBCNEQU",51,0)
W !!,"Entries with an asterisk (*) preceding the Insurance Co name already exist in"
"RTN","IBCNEQU",52,0)
W !,"the Insurance Buffer with the exact same name, the exact same Group Number,"
"RTN","IBCNEQU",53,0)
W !,"and the Override Freshness Flag set to 'Yes'. Selecting an entry with an"
"RTN","IBCNEQU",54,0)
W !,"asterisk (*) will create a duplicate entry in the Insurance Buffer file for"
"RTN","IBCNEQU",55,0)
W !,"the patient."
"RTN","IBCNEQU",56,0)
; IB*2*601/DM
"RTN","IBCNEQU",57,0)
W !!,"When requesting a MBI lookup..."
"RTN","IBCNEQU",58,0)
W !,"Policies will be listed as described above for electronic insurance inquiry,"
"RTN","IBCNEQU",59,0)
W !,"however, no special 'checks' will be made."
"RTN","IBCNEQU",60,0)
W !,"The MBI request will be initiated immediately, regardless of policies above."
"RTN","IBCNEQU",61,0)
D PAUSE^VALM1
"RTN","IBCNEQU",62,0)
S VALMBCK="R"
"RTN","IBCNEQU",63,0)
Q
"RTN","IBCNEQU",64,0)
;
"RTN","IBCNEQU",65,0)
EXIT ; -- exit code
"RTN","IBCNEQU",66,0)
K ^TMP("IBCNEQU",$J),^TMP("IBCNEQUX",$J)
"RTN","IBCNEQU",67,0)
Q
"RTN","IBCNEQU",68,0)
;
"RTN","IBCNEQU",69,0)
PAT() ; Prompt user to select a patient
"RTN","IBCNEQU",70,0)
; Init vars
"RTN","IBCNEQU",71,0)
N DIC,X,Y,DISYS,%H,%I,DUOUT,DTOUT
"RTN","IBCNEQU",72,0)
;
"RTN","IBCNEQU",73,0)
W !
"RTN","IBCNEQU",74,0)
; Exclude non-Veterans
"RTN","IBCNEQU",75,0)
S DIC(0)="AEQMN"
"RTN","IBCNEQU",76,0)
S DIC("S")="I $G(^(""VET""))=""Y"",('$P($G(^(0)),U,21))",DIC="^DPT("
"RTN","IBCNEQU",77,0)
D ^DIC
"RTN","IBCNEQU",78,0)
I $D(DUOUT)!$D(DTOUT)!(Y<1) Q ""
"RTN","IBCNEQU",79,0)
;
"RTN","IBCNEQU",80,0)
Q +Y
"RTN","IBCNEQU",81,0)
;
"RTN","IBCNEQU",82,0)
BLD(DFN) ; Build list of all insurance for patient
"RTN","IBCNEQU",83,0)
N IBCT,IBINS,IBDATA0,IBDATA1,IBDATA2,II,STR,IBINSIEN,IBINAME,IBHOLD
"RTN","IBCNEQU",84,0)
N VNODT,X,POP,IBBUF,IBBUFNM,IBIEN,IBBUFDT,TMPNM,GRPNUM,SFANAME
"RTN","IBCNEQU",85,0)
;
"RTN","IBCNEQU",86,0)
K ^TMP("IBCNEQU",$J),^TMP("IBCNEQUX",$J)
"RTN","IBCNEQU",87,0)
;
"RTN","IBCNEQU",88,0)
S (IBCT,VALMCNT)=0
"RTN","IBCNEQU",89,0)
;
"RTN","IBCNEQU",90,0)
; Determine if buffer entries exist for this DFN and build array by name
"RTN","IBCNEQU",91,0)
S IBIEN=0
"RTN","IBCNEQU",92,0)
F S IBIEN=$O(^IBA(355.33,"C",DFN,IBIEN)) Q:'IBIEN D
"RTN","IBCNEQU",93,0)
. S IBBUFDT=$G(^IBA(355.33,IBIEN,0))
"RTN","IBCNEQU",94,0)
. ; Include E status only
"RTN","IBCNEQU",95,0)
. I $P(IBBUFDT,U,4)'="E" Q
"RTN","IBCNEQU",96,0)
. S IBBUFNM=$$TRIM^XLFSTR($P($G(^IBA(355.33,IBIEN,20)),U))
"RTN","IBCNEQU",97,0)
. I IBBUFNM="" Q
"RTN","IBCNEQU",98,0)
. ;S GRPNUM=$$TRIM^XLFSTR($P($G(^IBA(355.33,IBIEN,40)),U,3))
"RTN","IBCNEQU",99,0)
. S GRPNUM=$$TRIM^XLFSTR($P($G(^IBA(355.33,IBIEN,90)),U,2)) ; ib*2*497 get group number from it's new location
"RTN","IBCNEQU",100,0)
. S IBBUF(IBBUFNM," "_GRPNUM)=""
"RTN","IBCNEQU",101,0)
. Q
"RTN","IBCNEQU",102,0)
;
"RTN","IBCNEQU",103,0)
; Populate IBINS array with Patient Insurance records
"RTN","IBCNEQU",104,0)
D ALL^IBCNS1(DFN,"IBINS")
"RTN","IBCNEQU",105,0)
I $G(IBINS(0)) S II=0 F S II=$O(IBINS(II)) Q:'II D
"RTN","IBCNEQU",106,0)
. S IBDATA0=$G(IBINS(II,0))
"RTN","IBCNEQU",107,0)
. S IBDATA1=$G(IBINS(II,1))
"RTN","IBCNEQU",108,0)
. S IBDATA2=$G(^IBA(355.3,+$P(IBDATA0,U,18),0))
"RTN","IBCNEQU",109,0)
. S GRPNUM=$$TRIM^XLFSTR($P($G(^IBA(355.3,+$P(IBDATA0,U,18),2)),U,2)) ; ib*2*497 get group number from it's new location
"RTN","IBCNEQU",110,0)
. ;S GRPNUM=$$TRIM^XLFSTR($P(GRPNUM,U,2))
"RTN","IBCNEQU",111,0)
. ;S GRPNUM=$$TRIM^XLFSTR($P(IBDATA2,U,4))
"RTN","IBCNEQU",112,0)
. S IBINSIEN=+$P(IBDATA0,U)
"RTN","IBCNEQU",113,0)
. Q:'IBINSIEN!'$D(^DIC(36,IBINSIEN,0))
"RTN","IBCNEQU",114,0)
. S IBINAME=$P($G(^DIC(36,IBINSIEN,0)),U)
"RTN","IBCNEQU",115,0)
. S TMPNM=$$TRIM^XLFSTR(IBINAME)
"RTN","IBCNEQU",116,0)
. ; Filter Ins Co's by name - currently filter Medicaid
"RTN","IBCNEQU",117,0)
. I $$EXCLUDE^IBCNEUT4(TMPNM) Q
"RTN","IBCNEQU",118,0)
. S IBCT=IBCT+1
"RTN","IBCNEQU",119,0)
. S STR=""
"RTN","IBCNEQU",120,0)
. S STR=$$SETFLD^VALM1(IBCT,STR,"NUMBER")
"RTN","IBCNEQU",121,0)
. ; Update IBINAME if found in buffer already
"RTN","IBCNEQU",122,0)
. S IBINAME=$S($D(IBBUF(TMPNM," "_GRPNUM)):"*",1:"")_IBINAME
"RTN","IBCNEQU",123,0)
. S STR=$$SETFLD^VALM1(IBINAME,STR,"NAME")
"RTN","IBCNEQU",124,0)
. S STR=$$SETFLD^VALM1($E($P(IBDATA0,U,2),1,14),STR,"POLICY")
"RTN","IBCNEQU",125,0)
. S IBHOLD=$P(IBDATA0,U,6),STR=$$SETFLD^VALM1($S(IBHOLD="v":"SELF",IBHOLD="s":"SPOUSE",IBHOLD="o":"OTHER",1:"UNKNOWN"),STR,"HOLDER")
"RTN","IBCNEQU",126,0)
. S STR=$$SETFLD^VALM1($E($$GRP^IBCNS($P(IBDATA0,U,18)),1,10),STR,"GROUP")
"RTN","IBCNEQU",127,0)
. S STR=$$SETFLD^VALM1($$FMTE^XLFDT($P(IBDATA0,U,8),"5Z"),STR,"EFFDT")
"RTN","IBCNEQU",128,0)
. S STR=$$SETFLD^VALM1($$FMTE^XLFDT($P(IBDATA0,U,4),"5Z"),STR,"EXPIRE")
"RTN","IBCNEQU",129,0)
. S STR=$$SETFLD^VALM1($E($P($G(^IBE(355.1,+$P(IBDATA2,U,9),0)),U),1,8),STR,"TYPE")
"RTN","IBCNEQU",130,0)
. S STR=$$SETFLD^VALM1($P($G(^IBE(355.1,+$P(IBDATA2,U,9),0)),U),STR,"TYPEPOL")
"RTN","IBCNEQU",131,0)
. S STR=$$SETFLD^VALM1($E($P($G(^VA(200,+$P(IBDATA1,U,4),0)),U),1,15),STR,"VERIFIED BY")
"RTN","IBCNEQU",132,0)
. S STR=$$SETFLD^VALM1($$FMTE^XLFDT($P(IBDATA1,U,3),"5Z"),STR,"VERIFIED ON")
"RTN","IBCNEQU",133,0)
. S STR=$$SETFLD^VALM1($$YN($P(IBDATA2,U,6)),STR,"PRECERT")
"RTN","IBCNEQU",134,0)
. S STR=$$SETFLD^VALM1($$YN($P(IBDATA2,U,5)),STR,"UR")
"RTN","IBCNEQU",135,0)
. S STR=$$SETFLD^VALM1($$YN($P(IBDATA0,U,20)),STR,"COB")
"RTN","IBCNEQU",136,0)
. D SET(STR)
"RTN","IBCNEQU",137,0)
. Q
"RTN","IBCNEQU",138,0)
;
"RTN","IBCNEQU",139,0)
I 'IBCT D
"RTN","IBCNEQU",140,0)
. S VALMCNT=VALMCNT+1
"RTN","IBCNEQU",141,0)
. S ^TMP("IBCNEQU",$J,VALMCNT,0)=" "
"RTN","IBCNEQU",142,0)
. S VALMCNT=VALMCNT+1
"RTN","IBCNEQU",143,0)
. S ^TMP("IBCNEQU",$J,VALMCNT,0)=" No eligible insurance policies found."
"RTN","IBCNEQU",144,0)
. Q
"RTN","IBCNEQU",145,0)
;
"RTN","IBCNEQU",146,0)
S VNODT=$P($G(^IBA(354,DFN,60)),U,1) I VNODT D
"RTN","IBCNEQU",147,0)
. S VALMCNT=VALMCNT+1
"RTN","IBCNEQU",148,0)
. S ^TMP("IBCNEQU",$J,VALMCNT,0)=" "
"RTN","IBCNEQU",149,0)
. S VALMCNT=VALMCNT+1
"RTN","IBCNEQU",150,0)
. S ^TMP("IBCNEQU",$J,VALMCNT,0)=" Verification of No Coverage "_$$FMTE^XLFDT(VNODT,"5Z")_"."
"RTN","IBCNEQU",151,0)
. Q
"RTN","IBCNEQU",152,0)
;
"RTN","IBCNEQU",153,0)
BLDX ; BLD exit pt
"RTN","IBCNEQU",154,0)
Q
"RTN","IBCNEQU",155,0)
;
"RTN","IBCNEQU",156,0)
SET(LINE) ; -- set arrays
"RTN","IBCNEQU",157,0)
; LINE - line of text to display
"RTN","IBCNEQU",158,0)
S VALMCNT=VALMCNT+1
"RTN","IBCNEQU",159,0)
S ^TMP("IBCNEQU",$J,VALMCNT,0)=LINE
"RTN","IBCNEQU",160,0)
S ^TMP("IBCNEQU",$J,"IDX",VALMCNT,IBCT)=""
"RTN","IBCNEQU",161,0)
S ^TMP("IBCNEQUX",$J,IBCT)=VALMCNT_U_DFN_U_II_U_IBINAME_U_IBDATA0
"RTN","IBCNEQU",162,0)
S ^TMP("IBCNEQUX",$J)=$G(^TMP("IBCNEQUX",$J))+1
"RTN","IBCNEQU",163,0)
Q
"RTN","IBCNEQU",164,0)
;
"RTN","IBCNEQU",165,0)
YN(X) ; -- convert 1 or 0 to yes/no/unknown
"RTN","IBCNEQU",166,0)
Q $S(X=0:"NO",X=1:"YES",1:"UNK")
"RTN","IBCNEQU",167,0)
;
"RTN","IBCNEQU",168,0)
SELECT ; User selects insurance from list to be reconfirmed
"RTN","IBCNEQU",169,0)
N IBDATA,IBDPT,IBDA,DIR,X,Y,D0,DG,DIC,DISYS,DIW,IENS,IBELIGDT,IBERROR,IBIEN,IBSYM
"RTN","IBCNEQU",170,0)
;
"RTN","IBCNEQU",171,0)
D FULL^VALM1
"RTN","IBCNEQU",172,0)
S VALMBCK="R"
"RTN","IBCNEQU",173,0)
;
"RTN","IBCNEQU",174,0)
I '$O(^TMP("IBCNEQUX",$J,0)) D G SELECTX
"RTN","IBCNEQU",175,0)
. W !!,"No Insurance policies to select."
"RTN","IBCNEQU",176,0)
. S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEQU",177,0)
. Q
"RTN","IBCNEQU",178,0)
;
"RTN","IBCNEQU",179,0)
S (IBDPT,IBDA,IBERROR)=""
"RTN","IBCNEQU",180,0)
S IBDATA=$$SEL()
"RTN","IBCNEQU",181,0)
S IBDPT=+$P(IBDATA,U) ; Patient DFN
"RTN","IBCNEQU",182,0)
S IBDA=+$P(IBDATA,U,2) ; 2.312 ptr
"RTN","IBCNEQU",183,0)
I +IBDPT,+IBDA D
"RTN","IBCNEQU",184,0)
. S IBIEN=+$P(IBDATA,U,4) ; Ins Co IEN (#36)
"RTN","IBCNEQU",185,0)
. S IBSYM=$P($$INSERROR^IBCNEUT3("I",IBIEN),"^",1)
"RTN","IBCNEQU",186,0)
. S ^TMP("IBCNEQUDTS",$J)=1
"RTN","IBCNEQU",187,0)
. D PT^IBCNEBF(IBDPT,IBDA,IBSYM,1,1,.IBERROR)
"RTN","IBCNEQU",188,0)
. ; Check for errors
"RTN","IBCNEQU",189,0)
. I $G(IBERROR)'="" W !!,"Insurance Buffer entry could not be created due to error! Please try again.",!
"RTN","IBCNEQU",190,0)
. I $G(IBERROR)="" W !!,"Insurance Buffer entry created!",!
"RTN","IBCNEQU",191,0)
. S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEQU",192,0)
. K ^TMP("IBCNEQUDTS",$J)
"RTN","IBCNEQU",193,0)
;
"RTN","IBCNEQU",194,0)
I $P(IBDATA,U,3)="~NO PAYER" D
"RTN","IBCNEQU",195,0)
. W !!,"Payer missing. Identification inquiries not allowed." ; IB*2*416
"RTN","IBCNEQU",196,0)
. S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEQU",197,0)
. Q
"RTN","IBCNEQU",198,0)
;
"RTN","IBCNEQU",199,0)
SELECTX ;
"RTN","IBCNEQU",200,0)
S VALMBCK="R"
"RTN","IBCNEQU",201,0)
Q
"RTN","IBCNEQU",202,0)
;
"RTN","IBCNEQU",203,0)
SEL() ; User selects insurance from list
"RTN","IBCNEQU",204,0)
N IBSELN,DIR,X,Y,DIRUT,DUOUT
"RTN","IBCNEQU",205,0)
;
"RTN","IBCNEQU",206,0)
S IBSELN=""
"RTN","IBCNEQU",207,0)
; Select entry to reconfirm
"RTN","IBCNEQU",208,0)
S DIR(0)="NO^1:"_$G(^TMP("IBCNEQUX",$J))_":0"
"RTN","IBCNEQU",209,0)
S DIR("A")="Select entry to request electronic inquiry"
"RTN","IBCNEQU",210,0)
S DIR("?",1)=" Select an entry to initiate an insurance inquiry."
"RTN","IBCNEQU",211,0)
S DIR("?",2)=" If entry contains an Insurance Co name, an Insurance"
"RTN","IBCNEQU",212,0)
S DIR("?",3)=" Buffer entry will be created for nightly batch extract."
"RTN","IBCNEQU",213,0)
S DIR("?")=" "
"RTN","IBCNEQU",214,0)
D ^DIR K DIR
"RTN","IBCNEQU",215,0)
I $D(DIRUT)!$D(DUOUT)!(Y<1) G SELX
"RTN","IBCNEQU",216,0)
S IBSELN=$O(^TMP("IBCNEQU",$J,"IDX",Y,0))
"RTN","IBCNEQU",217,0)
I IBSELN S IBSELN=$P($G(^TMP("IBCNEQUX",$J,IBSELN)),U,2,99)
"RTN","IBCNEQU",218,0)
I $E($P(IBSELN,U,3))="*" W ! D S IBSELN="" G SELX
"RTN","IBCNEQU",219,0)
.S DIR(0)="EA"
"RTN","IBCNEQU",220,0)
.S DIR("A",1)=""
"RTN","IBCNEQU",221,0)
.S DIR("A",2)="Selected policy has an existing buffer entry."
"RTN","IBCNEQU",222,0)
.S DIR("A",3)="You must first process the existing buffer entry."
"RTN","IBCNEQU",223,0)
.S DIR("A")="Press RETURN to continue " D ^DIR K DIR W !
"RTN","IBCNEQU",224,0)
.Q
"RTN","IBCNEQU",225,0)
;
"RTN","IBCNEQU",226,0)
; Get service type code
"RTN","IBCNEQU",227,0)
D STC
"RTN","IBCNEQU",228,0)
I X="^" S IBSELN="" G SELX ; '^' entered thus backup a level & re-ask Insurance question
"RTN","IBCNEQU",229,0)
; Get eligibility date
"RTN","IBCNEQU",230,0)
S IBELIGDT=$$ELIGDT() I 'IBELIGDT S IBSELN="" G SELX
"RTN","IBCNEQU",231,0)
W !
"RTN","IBCNEQU",232,0)
S DIR(0)="Y"
"RTN","IBCNEQU",233,0)
S DIR("A")="Are you sure you want to request an insurance inquiry"
"RTN","IBCNEQU",234,0)
S DIR("B")="NO"
"RTN","IBCNEQU",235,0)
S DIR("?",1)=" If yes, a request will be created for the nightly batch."
"RTN","IBCNEQU",236,0)
D ^DIR K DIR
"RTN","IBCNEQU",237,0)
I $D(DIRUT)!$D(DUOUT)!('Y) S IBSELN=""
"RTN","IBCNEQU",238,0)
;
"RTN","IBCNEQU",239,0)
SELX Q IBSELN
"RTN","IBCNEQU",240,0)
;
"RTN","IBCNEQU",241,0)
STC ; Ask for service type code to send
"RTN","IBCNEQU",242,0)
; IB*582/HN - Modified Default Service Type Code to pull from the MCCF Billing Parameters File (350.9,60.01)
"RTN","IBCNEQU",243,0)
N DIR,X,Y
"RTN","IBCNEQU",244,0)
; IBEISTC used as STC variable
"RTN","IBCNEQU",245,0)
S IBEISTC=""
"RTN","IBCNEQU",246,0)
S DIR(0)="PAO^365.013:EMZ",DIR("A")="Enter Service Type Code: "
"RTN","IBCNEQU",247,0)
S DIR("B")=$$GET1^DIQ(350.9,1_",",60.01,"E")
"RTN","IBCNEQU",248,0)
S DIR("??")="^D HELPSTC2^IBCNEQU"
"RTN","IBCNEQU",249,0)
STCEN ; Intital and re-enterant tag upon error
"RTN","IBCNEQU",250,0)
D ^DIR Q:X="^"
"RTN","IBCNEQU",251,0)
; Check to verify code is active, if not, display error and ask again
"RTN","IBCNEQU",252,0)
I $P($G(Y(0)),U,3)'="" W !,"Code selected is not an active code - please select another code.",! G STCEN
"RTN","IBCNEQU",253,0)
; If valid STC entered, set IBEISTC to be STC IEN. If no code entered, default to service code 30
"RTN","IBCNEQU",254,0)
;S IBEISTC=$S(+Y>0:$P(Y,U,1),1:$O(^IBE(365.013,"B",30,"")))
"RTN","IBCNEQU",255,0)
; If valid STC entered, set IBEISTC to be STCIEN.
"RTN","IBCNEQU",256,0)
S IBEISTC=$P(Y,U,1)
"RTN","IBCNEQU",257,0)
Q
"RTN","IBCNEQU",258,0)
;
"RTN","IBCNEQU",259,0)
FASTEXIT ; Sets flag to indicate a quick exit from the option
"RTN","IBCNEQU",260,0)
N DIR,DIRUT,X,Y
"RTN","IBCNEQU",261,0)
S VALMBCK="Q"
"RTN","IBCNEQU",262,0)
D FULL^VALM1
"RTN","IBCNEQU",263,0)
S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO"
"RTN","IBCNEQU",264,0)
D ^DIR
"RTN","IBCNEQU",265,0)
I +Y S IBFASTXT=1
"RTN","IBCNEQU",266,0)
Q
"RTN","IBCNEQU",267,0)
;
"RTN","IBCNEQU",268,0)
ADD() ;
"RTN","IBCNEQU",269,0)
NEW PAYER,TQIEN,OK,STR,SRVICEDT,FRESHDT,DATA1,DATA2,TQIEN,FRESHDAY
"RTN","IBCNEQU",270,0)
I '$D(^IBCN(365.1,"E",DFN)) Q 0 ; Does this pt have a TQ entry?
"RTN","IBCNEQU",271,0)
S (TQIEN,OK)=""
"RTN","IBCNEQU",272,0)
S PAYER=$$FIND1^DIC(365.12,,"X","~NO PAYER") ; Get payer IEN
"RTN","IBCNEQU",273,0)
F S TQIEN=$O(^IBCN(365.1,"E",DFN,TQIEN)) Q:'TQIEN!OK D
"RTN","IBCNEQU",274,0)
. S STR=$G(^IBCN(365.1,TQIEN,0))
"RTN","IBCNEQU",275,0)
. ; If "~NO PAYER" & Transmitted
"RTN","IBCNEQU",276,0)
. I $P(STR,U,3)=PAYER,$P(STR,U,4)=2 S OK=1 Q
"RTN","IBCNEQU",277,0)
. ; If "~NO PAYER" & Ready to Transmit & override flag
"RTN","IBCNEQU",278,0)
. I $P(STR,U,3)=PAYER,($P(STR,U,4)=1),($P(STR,U,14)=1) S OK=1 Q
"RTN","IBCNEQU",279,0)
I 'OK Q 0
"RTN","IBCNEQU",280,0)
Q 1
"RTN","IBCNEQU",281,0)
;
"RTN","IBCNEQU",282,0)
BLKTQ ; Create a ~NO PAYER request for 'Search for All'
"RTN","IBCNEQU",283,0)
Q ; no longer allowed IB*2*416
"RTN","IBCNEQU",284,0)
NEW PAYER,SRVICEDT,FRESHDT,DATA1,DATA2,TQIEN,FRESHDAY
"RTN","IBCNEQU",285,0)
S PAYER=$$FIND1^DIC(365.12,,"X","~NO PAYER")
"RTN","IBCNEQU",286,0)
D NPINIT ; Update service date and freshness
"RTN","IBCNEQU",287,0)
; Update service dates for inquiries to be transmitted
"RTN","IBCNEQU",288,0)
S DATA1=DFN_U_PAYER_U_1_U_""_U_""_U_FRESHDT
"RTN","IBCNEQU",289,0)
S DATA2=5_U_"I"_U_SRVICEDT ;IB*2.0*631/TAZ
"RTN","IBCNEQU",290,0)
S TQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,"",1)
"RTN","IBCNEQU",291,0)
Q
"RTN","IBCNEQU",292,0)
;
"RTN","IBCNEQU",293,0)
BLKX Q
"RTN","IBCNEQU",294,0)
;
"RTN","IBCNEQU",295,0)
NPINIT ; Initialize variables for ~NO PAYER
"RTN","IBCNEQU",296,0)
S SRVICEDT=DT
"RTN","IBCNEQU",297,0)
S FRESHDAY=$P($G(^IBE(350.9,1,51)),U)
"RTN","IBCNEQU",298,0)
S FRESHDT=$$FMADD^XLFDT(SRVICEDT,-FRESHDAY)
"RTN","IBCNEQU",299,0)
;
"RTN","IBCNEQU",300,0)
; Update service date and freshness date based on payer allowed
"RTN","IBCNEQU",301,0)
Q
"RTN","IBCNEQU",302,0)
;
"RTN","IBCNEQU",303,0)
HELPSTC2 ; Text to display in response to '??' entry
"RTN","IBCNEQU",304,0)
N DIR
"RTN","IBCNEQU",305,0)
D FULL^VALM1
"RTN","IBCNEQU",306,0)
W @IOF
"RTN","IBCNEQU",307,0)
W !,"Enter the single SERVICE TYPE CODE to be sent with inquiry or press 'ENTER' to"
"RTN","IBCNEQU",308,0)
W !,"send default service type code 30 (Health Benefit Plan Coverage)."
"RTN","IBCNEQU",309,0)
W !,"No response generated by this option will auto-update the patient file."
"RTN","IBCNEQU",310,0)
Q
"RTN","IBCNEQU",311,0)
;
"RTN","IBCNEQU",312,0)
ELIGDT() ; Prompt user for eligibility date
"RTN","IBCNEQU",313,0)
N DIR,X,Y,DIRUT,DUOUT,STARTDT,ENDDT,ELIGDT
"RTN","IBCNEQU",314,0)
S ELIGDT=""
"RTN","IBCNEQU",315,0)
D DT^DILF(,"T-12M",.STARTDT) ; start date within the last 12 months
"RTN","IBCNEQU",316,0)
; allow end date up to the end of the current month
"RTN","IBCNEQU",317,0)
S ENDDT=$$SCH^XLFDT("1M(L@1A)",DT)\1 ; ICR#10103 this call returns the last day of the current month at 1 AM. If not time was sent, it would actually return the next to last day at 2400 hours.
"RTN","IBCNEQU",318,0)
S DIR(0)="DA^"_STARTDT_":"_ENDDT_":"_"EX",DIR("A")="Enter Eligibility Date: ",DIR("B")="TODAY"
"RTN","IBCNEQU",319,0)
S DIR("?",1)="Select an eligibility date to be sent in the inquiry."
"RTN","IBCNEQU",320,0)
S DIR("?")="Date must be within the last 12 months or up to the end of the current month."
"RTN","IBCNEQU",321,0)
D ^DIR
"RTN","IBCNEQU",322,0)
I $D(DIRUT)!$D(DUOUT)!('Y) G ELIGDTX
"RTN","IBCNEQU",323,0)
S ELIGDT=Y
"RTN","IBCNEQU",324,0)
ELIGDTX ;
"RTN","IBCNEQU",325,0)
Q ELIGDT
"RTN","IBCNEQU",326,0)
;
"RTN","IBCNEQU",327,0)
MBIREQ ; User requested a MBI lookup request
"RTN","IBCNEQU",328,0)
N DIR,X,Y,DIRUT,DUOUT
"RTN","IBCNEQU",329,0)
N IBMBIPYR,IBBUF,IBFDA
"RTN","IBCNEQU",330,0)
;
"RTN","IBCNEQU",331,0)
D FULL^VALM1
"RTN","IBCNEQU",332,0)
S VALMBCK="R"
"RTN","IBCNEQU",333,0)
K DIR
"RTN","IBCNEQU",334,0)
;
"RTN","IBCNEQU",335,0)
; see if the MBI PAYER site parameter has been populated
"RTN","IBCNEQU",336,0)
S IBMBIPYR=+$$GET1^DIQ(350.9,"1,","MBI PAYER","I")
"RTN","IBCNEQU",337,0)
I 'IBMBIPYR D G MBIREQX
"RTN","IBCNEQU",338,0)
. W !!," The required MBI Payer site parameter is not populated; try again later",!
"RTN","IBCNEQU",339,0)
. S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEQU",340,0)
;
"RTN","IBCNEQU",341,0)
I '($$GET1^DIQ(365.121,"1,"_IBMBIPYR_",",.02,"I")) D G MBIREQX
"RTN","IBCNEQU",342,0)
. W !!," The MBI Payer is not nationally active; try again later",!
"RTN","IBCNEQU",343,0)
. S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEQU",344,0)
;
"RTN","IBCNEQU",345,0)
I '($$GET1^DIQ(365.121,"1,"_IBMBIPYR_",",.03,"I")) D G MBIREQX
"RTN","IBCNEQU",346,0)
. W !!," The MBI Payer LOCAL ACTIVE field is set to 'NO'; it must be 'YES' to proceed",!
"RTN","IBCNEQU",347,0)
. S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEQU",348,0)
;
"RTN","IBCNEQU",349,0)
D DEM^VADPT ; ; ICR#10061
"RTN","IBCNEQU",350,0)
I ($P(VADM(2),U)="")!($P(VADM(3),U)="") D G MBIREQX
"RTN","IBCNEQU",351,0)
. W !!," SSN and DOB are required fields, they must be populated in order to proceed",!
"RTN","IBCNEQU",352,0)
. S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEQU",353,0)
;
"RTN","IBCNEQU",354,0)
S DIR(0)="Y"
"RTN","IBCNEQU",355,0)
S DIR("A")="Are you sure you want to request this Patient's Medicare Beneficiary ID"
"RTN","IBCNEQU",356,0)
S DIR("B")="YES"
"RTN","IBCNEQU",357,0)
S DIR("?",1)=" If yes, a MBI request will be initiated immediately."
"RTN","IBCNEQU",358,0)
S DIR("?")=" If no, the MBI request will be cancelled."
"RTN","IBCNEQU",359,0)
D ^DIR K DIR
"RTN","IBCNEQU",360,0)
I $D(DIRUT)!$D(DUOUT)!('Y) G MBIREQX
"RTN","IBCNEQU",361,0)
;
"RTN","IBCNEQU",362,0)
;write a buffer entry
"RTN","IBCNEQU",363,0)
;the real time process will set the patient relationship to self automatically
"RTN","IBCNEQU",364,0)
;patient fields, name, dob and ssn will be populated automatically
"RTN","IBCNEQU",365,0)
K IBBUF
"RTN","IBCNEQU",366,0)
S IBBUF(.02)=DUZ ; Entered By
"RTN","IBCNEQU",367,0)
S IBBUF(.12)=$P($$PAYER^IBCNEUT4(IBMBIPYR),U) ; Buffer Symbol
"RTN","IBCNEQU",368,0)
S IBBUF(20.01)=$$GET1^DIQ(350.9,"1,","MBI PAYER","E")
"RTN","IBCNEQU",369,0)
S IBBUF(60.01)=DFN ; Patient IEN
"RTN","IBCNEQU",370,0)
S IBBUF(90.03)="MBIrequest" ; MBI placeholder for subscriber ID
"RTN","IBCNEQU",371,0)
S IBBUF(91.01)=VADM(1) ; patient (subscriber) name
"RTN","IBCNEQU",372,0)
; the following call in-turn, calls EDITSTF^IBCNBES which will make sure to file subscriber ID last, automatically
"RTN","IBCNEQU",373,0)
S IBFDA=$$ADDSTF^IBCNBES($$FIND1^DIC(355.12,,,"MEDICARE","C"),DFN,.IBBUF)
"RTN","IBCNEQU",374,0)
;
"RTN","IBCNEQU",375,0)
W !!,"The MBI request was successful, check the buffer for results.",!
"RTN","IBCNEQU",376,0)
S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEQU",377,0)
S VALMBCK="Q"
"RTN","IBCNEQU",378,0)
Q
"RTN","IBCNEQU",379,0)
MBIREQX ;
"RTN","IBCNEQU",380,0)
S VALMBCK="R"
"RTN","IBCNEQU",381,0)
Q
"RTN","IBCNEQU",382,0)
;
"RTN","IBCNERP8")
0^8^B111034768^B110475563
"RTN","IBCNERP8",1,0)
IBCNERP8 ;DAOU/BHS - IBCNE eIV STATISTICAL REPORT COMPILE ;11-JUN-2002
"RTN","IBCNERP8",2,0)
;;2.0;INTEGRATED BILLING;**184,271,345,416,506,621,631**;21-MAR-94;Build 11
"RTN","IBCNERP8",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNERP8",4,0)
;
"RTN","IBCNERP8",5,0)
; eIV - Insurance Verification Interface
"RTN","IBCNERP8",6,0)
;
"RTN","IBCNERP8",7,0)
;Input vars from IBCNERP7:
"RTN","IBCNERP8",8,0)
; IBCNERTN = "IBCNERP7"
"RTN","IBCNERP8",9,0)
; **IBCNESPC array ONLY passed by reference **
"RTN","IBCNERP8",10,0)
; IBCNESPC("BEGDTM") = Start Dt/Tm for rpt range
"RTN","IBCNERP8",11,0)
; IBCNESPC("ENDDTM") = End Dt/Tm for rpt range
"RTN","IBCNERP8",12,0)
; IBCNESPC("SECTS") = 1 - All sections OR ',' sep'd list of 1 or more
"RTN","IBCNERP8",13,0)
; of the following (not all)
"RTN","IBCNERP8",14,0)
; 2 - Outgoing data, inq trans stats
"RTN","IBCNERP8",15,0)
; 3 - Incoming data, resps rec'd stats
"RTN","IBCNERP8",16,0)
; 4 - Current status, pending resps, queued inqs, deferred inqs, payer
"RTN","IBCNERP8",17,0)
; stats, ins buf stats
"RTN","IBCNERP8",18,0)
; IBCNESPC("MM") = "" - do not generate MailMan message OR MAILGROUP to
"RTN","IBCNERP8",19,0)
; send report to Mail Group as defined in the IB site parameters
"RTN","IBCNERP8",20,0)
;Output vars:
"RTN","IBCNERP8",21,0)
; Based on IBCNESPC("SECTS") parameter the following scratch globals
"RTN","IBCNERP8",22,0)
; may be built
"RTN","IBCNERP8",23,0)
; 1 OR contains 2 -->
"RTN","IBCNERP8",24,0)
; ^TMP($J,RTN,"OUT")=TotInq^InsBufExtSubtotal^PreRegExtSubtotal^...
"RTN","IBCNERP8",25,0)
; NonVerifInsExtSubtotal^NoActInsExtSubtotal
"RTN","IBCNERP8",26,0)
; 1 OR contains 3 -->
"RTN","IBCNERP8",27,0)
; ^TMP($J,RTN,"IN")=TotResp^InsBufExtSubtotal^PreRegExtSubtotal^...
"RTN","IBCNERP8",28,0)
; NonVerifInsExtSubtotal^NoActInsExtSubtotal
"RTN","IBCNERP8",29,0)
; 1 OR contains 4 -->
"RTN","IBCNERP8",30,0)
; ^TMP($J,RTN,"CUR")=TotPendingResponses^TotQueuedInquiries^...
"RTN","IBCNERP8",31,0)
; TotDeferredInquiries(Hold)^TotInsCosw/oNationalID^...
"RTN","IBCNERP8",32,0)
; ToteIVPyrsDisabldLocally^TotUserActReq^TotInsBufVerified^TotalManVerified...
"RTN","IBCNERP8",33,0)
; TotaleIVVerified^TotInsBufUnverified^! InsBufSubtotal^...
"RTN","IBCNERP8",34,0)
; ? InsBufSubtotal^- InsBufSubtotal^Other InsBufSubtotal^...
"RTN","IBCNERP8",35,0)
; $ EscolatedBufSubtotal
"RTN","IBCNERP8",36,0)
; 1 OR contains 4 -->
"RTN","IBCNERP8",37,0)
; ^TMP($J,RTN,"PYR",PAYER,IEN)="" (list of new payers)
"RTN","IBCNERP8",38,0)
;
"RTN","IBCNERP8",39,0)
; Must call at EN
"RTN","IBCNERP8",40,0)
Q
"RTN","IBCNERP8",41,0)
;
"RTN","IBCNERP8",42,0)
EN(IBCNERTN,IBCNESPC) ; Entry pt
"RTN","IBCNERP8",43,0)
; Init vars
"RTN","IBCNERP8",44,0)
N IBBDT,IBEDT,IBSCT,IBTOT,PIECES,VALUE,CT
"RTN","IBCNERP8",45,0)
;
"RTN","IBCNERP8",46,0)
I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
"RTN","IBCNERP8",47,0)
;
"RTN","IBCNERP8",48,0)
S IBTOT=0
"RTN","IBCNERP8",49,0)
;
"RTN","IBCNERP8",50,0)
; Kill scratch global
"RTN","IBCNERP8",51,0)
K ^TMP($J,IBCNERTN)
"RTN","IBCNERP8",52,0)
;
"RTN","IBCNERP8",53,0)
; Init looping vars
"RTN","IBCNERP8",54,0)
S IBBDT=$G(IBCNESPC("BEGDTM")),IBEDT=$G(IBCNESPC("ENDDTM"))
"RTN","IBCNERP8",55,0)
S IBSCT=$G(IBCNESPC("SECTS"))
"RTN","IBCNERP8",56,0)
;
"RTN","IBCNERP8",57,0)
I IBSCT=1!$F(IBSCT,",2,") D OUT(IBCNERTN,IBBDT,IBEDT,.IBTOT)
"RTN","IBCNERP8",58,0)
I $G(ZTSTOP) G EXIT
"RTN","IBCNERP8",59,0)
I IBSCT=1!$F(IBSCT,",3,") D IN(IBCNERTN,IBBDT,IBEDT,.IBTOT)
"RTN","IBCNERP8",60,0)
I $G(ZTSTOP) G EXIT
"RTN","IBCNERP8",61,0)
I IBSCT=1!$F(IBSCT,",4,") D CUR(IBCNERTN,IBBDT,IBEDT,.IBTOT),PYR^IBCNERP0(IBCNERTN,IBBDT,IBEDT,.IBTOT)
"RTN","IBCNERP8",62,0)
;
"RTN","IBCNERP8",63,0)
EXIT ; EN Exit pt
"RTN","IBCNERP8",64,0)
Q
"RTN","IBCNERP8",65,0)
;
"RTN","IBCNERP8",66,0)
IN(RTN,BDT,EDT,TOT) ; Determine Incoming Data
"RTN","IBCNERP8",67,0)
; Input params: RTN-routine name for ^TMP($J), BDT-start dt/time,
"RTN","IBCNERP8",68,0)
; EDT-end dt/time, **TOT-total records searched - used only for status
"RTN","IBCNERP8",69,0)
; checks when the process is queued (passed by reference)
"RTN","IBCNERP8",70,0)
; Output vars: Set pcs of ^TMP($J,RTN,"IN") as follows:
"RTN","IBCNERP8",71,0)
; 1=total Resps rec'd for date/time range
"RTN","IBCNERP8",72,0)
; 2=Ins Buf extract subtotal
"RTN","IBCNERP8",73,0)
; 3=Pre-Reg extract subtotal
"RTN","IBCNERP8",74,0)
; 4=Non-ver extract subtotal
"RTN","IBCNERP8",75,0)
; 5=No Act Ins subtotal
"RTN","IBCNERP8",76,0)
;
"RTN","IBCNERP8",77,0)
; Init vars
"RTN","IBCNERP8",78,0)
N IBDT,PYRIEN,PATIEN,IBPTR,IBTYP,RPTDATA,TRANSIEN
"RTN","IBCNERP8",79,0)
;
"RTN","IBCNERP8",80,0)
; Loop thru the eIV Resp File (#365) x-ref on Date/Time Resp Rec'd
"RTN","IBCNERP8",81,0)
S IBDT=$O(^IBCN(365,"AD",BDT),-1)
"RTN","IBCNERP8",82,0)
F S IBDT=$O(^IBCN(365,"AD",IBDT)) Q:IBDT=""!(IBDT>EDT) D Q:$G(ZTSTOP)
"RTN","IBCNERP8",83,0)
. S PYRIEN=0
"RTN","IBCNERP8",84,0)
. F S PYRIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN)) Q:'PYRIEN D Q:$G(ZTSTOP)
"RTN","IBCNERP8",85,0)
. . S PATIEN=0
"RTN","IBCNERP8",86,0)
. . F S PATIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN)) Q:'PATIEN D Q:$G(ZTSTOP)
"RTN","IBCNERP8",87,0)
. . . S IBPTR=0
"RTN","IBCNERP8",88,0)
. . . F S IBPTR=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN,IBPTR)) Q:'IBPTR D Q:$G(ZTSTOP)
"RTN","IBCNERP8",89,0)
. . . . S TOT=TOT+1
"RTN","IBCNERP8",90,0)
. . . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",91,0)
. . . . ; Update total
"RTN","IBCNERP8",92,0)
. . . . S $P(RPTDATA,U,1)=$P($G(RPTDATA),U,1)+1
"RTN","IBCNERP8",93,0)
. . . . ; Update extract type total
"RTN","IBCNERP8",94,0)
. . . . ; Get the data for the report - build RPTDATA
"RTN","IBCNERP8",95,0)
. . . . ;IB*2.0*631/TAZ
"RTN","IBCNERP8",96,0)
. . . . ;S IBTYP=5,TRANSIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
"RTN","IBCNERP8",97,0)
. . . . S TRANSIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
"RTN","IBCNERP8",98,0)
. . . . ; IB*2.0*621
"RTN","IBCNERP8",99,0)
. . . . S TQIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
"RTN","IBCNERP8",100,0)
. . . . I TQIEN="" Q
"RTN","IBCNERP8",101,0)
. . . . S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
"RTN","IBCNERP8",102,0)
. . . . S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
"RTN","IBCNERP8",103,0)
. . . . S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
"RTN","IBCNERP8",104,0)
. . . . I IBTYP'="" D
"RTN","IBCNERP8",105,0)
. . . . . I IBTYP=3 Q
"RTN","IBCNERP8",106,0)
. . . . . ;IB*2.0*631
"RTN","IBCNERP8",107,0)
. . . . . I IBTYP=7 S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1 Q ; MBI Request``
"RTN","IBCNERP8",108,0)
. . . . . I ("~1~5~6~"[("~"_IBTYP_"~")) S $P(RPTDATA,U,2)=$P($G(RPTDATA),U,2)+1 Q
"RTN","IBCNERP8",109,0)
. . . . . I IBTYP=4 D Q
"RTN","IBCNERP8",110,0)
. . . . . . I IBQUERY="I" S $P(RPTDATA,U,4)=$P($G(RPTDATA),U,4)+1 ; EICD Queries
"RTN","IBCNERP8",111,0)
. . . . . . I IBQUERY="V" S $P(RPTDATA,U,5)=$P($G(RPTDATA),U,5)+1 ; EICD Verification
"RTN","IBCNERP8",112,0)
. . . . . S:IBTYP=2 $P(RPTDATA,U,3)=$P($G(RPTDATA),U,3)+1
"RTN","IBCNERP8",113,0)
. . . . ; IB*2.0*621 - End IN Group
"RTN","IBCNERP8",114,0)
;
"RTN","IBCNERP8",115,0)
I $G(ZTSTOP) G INX
"RTN","IBCNERP8",116,0)
;
"RTN","IBCNERP8",117,0)
; Save data to global
"RTN","IBCNERP8",118,0)
S ^TMP($J,RTN,"IN")=$G(RPTDATA)
"RTN","IBCNERP8",119,0)
;
"RTN","IBCNERP8",120,0)
INX ; IN exit pt
"RTN","IBCNERP8",121,0)
Q
"RTN","IBCNERP8",122,0)
;
"RTN","IBCNERP8",123,0)
OUT(RTN,BDT,EDT,TOT) ; Outgoing Data
"RTN","IBCNERP8",124,0)
;Input params: RTN-routine name used as subscript in ^TMP($J),
"RTN","IBCNERP8",125,0)
; BDT-start date/time, EDT-end date/time, **TOT-total recs searched-used
"RTN","IBCNERP8",126,0)
; only for status checks when process is queued (passed by reference)
"RTN","IBCNERP8",127,0)
;Output vars: Set pcs of ^TMP($J,RTN,"OUT") as follows:
"RTN","IBCNERP8",128,0)
; 1=total Inqs transmitted for timeframe
"RTN","IBCNERP8",129,0)
; 2=Ins Buffer extract subtotal
"RTN","IBCNERP8",130,0)
; 3=Pre-Reg extract subtotal
"RTN","IBCNERP8",131,0)
; 4=Non-Ver extract subtotal
"RTN","IBCNERP8",132,0)
; 5=No Act Ins subtotal
"RTN","IBCNERP8",133,0)
; 6=MBI subtotal
"RTN","IBCNERP8",134,0)
;
"RTN","IBCNERP8",135,0)
; Init vars
"RTN","IBCNERP8",136,0)
N IBDT,IBPTR,IBTYP,RPTDATA,TQIEN
"RTN","IBCNERP8",137,0)
;
"RTN","IBCNERP8",138,0)
; Loop thru the eIV Resp File (#365) by x-ref on Date/Time Resp Created
"RTN","IBCNERP8",139,0)
; Only count responses for unique HL7 message IDs - filter out
"RTN","IBCNERP8",140,0)
; unsolicited responses as they artificially inflate the Outgoing Count
"RTN","IBCNERP8",141,0)
S IBDT=$O(^IBCN(365,"AE",BDT),-1)
"RTN","IBCNERP8",142,0)
F S IBDT=$O(^IBCN(365,"AE",IBDT)) Q:IBDT=""!(IBDT>EDT) D Q:$G(ZTSTOP)
"RTN","IBCNERP8",143,0)
. S IBPTR=0
"RTN","IBCNERP8",144,0)
. F S IBPTR=$O(^IBCN(365,"AE",IBDT,IBPTR)) Q:'IBPTR D Q:$G(ZTSTOP)
"RTN","IBCNERP8",145,0)
. . S TOT=TOT+1
"RTN","IBCNERP8",146,0)
. . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",147,0)
. . ; Quit, if response was not O - original
"RTN","IBCNERP8",148,0)
. . I $P($G(^IBCN(365,IBPTR,0)),U,10)'="O" Q
"RTN","IBCNERP8",149,0)
. . ; Update total
"RTN","IBCNERP8",150,0)
. . S $P(RPTDATA,U,1)=$P($G(RPTDATA),U,1)+1
"RTN","IBCNERP8",151,0)
. . ; Update extract type total (1,2,3,4)
"RTN","IBCNERP8",152,0)
. . S TQIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
"RTN","IBCNERP8",153,0)
. . I TQIEN="" Q
"RTN","IBCNERP8",154,0)
. . ; IB*2.0*621
"RTN","IBCNERP8",155,0)
. . ;S IBTYP=$P($G(^IBCN(365.1,TQIEN,0)),U,10)
"RTN","IBCNERP8",156,0)
. . S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
"RTN","IBCNERP8",157,0)
. . S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
"RTN","IBCNERP8",158,0)
. . S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
"RTN","IBCNERP8",159,0)
. . I IBTYP'="" D
"RTN","IBCNERP8",160,0)
. . . I IBTYP=3 Q
"RTN","IBCNERP8",161,0)
. . . ;I IBTYP=1 D Q ;IB*2.0*631/TAZ
"RTN","IBCNERP8",162,0)
. . . I IBTYP=7 S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1 Q ; MBI Request``
"RTN","IBCNERP8",163,0)
. . . I ("~1~5~6~"[("~"_IBTYP_"~")) S $P(RPTDATA,U,2)=$P($G(RPTDATA),U,2)+1 Q
"RTN","IBCNERP8",164,0)
. . . I IBTYP=4 D Q
"RTN","IBCNERP8",165,0)
. . . . I IBQUERY="I" S $P(RPTDATA,U,4)=$P($G(RPTDATA),U,4)+1 ; EICD Queries
"RTN","IBCNERP8",166,0)
. . . . I IBQUERY="V" S $P(RPTDATA,U,5)=$P($G(RPTDATA),U,5)+1 ; EICD Verification
"RTN","IBCNERP8",167,0)
. . . S:IBTYP=2 $P(RPTDATA,U,3)=$P($G(RPTDATA),U,3)+1
"RTN","IBCNERP8",168,0)
;
"RTN","IBCNERP8",169,0)
I $G(ZTSTOP) G OUTX
"RTN","IBCNERP8",170,0)
;
"RTN","IBCNERP8",171,0)
; Save data to global array
"RTN","IBCNERP8",172,0)
S ^TMP($J,RTN,"OUT")=$G(RPTDATA)
"RTN","IBCNERP8",173,0)
;
"RTN","IBCNERP8",174,0)
OUTX ; OUT exit pt
"RTN","IBCNERP8",175,0)
Q
"RTN","IBCNERP8",176,0)
;
"RTN","IBCNERP8",177,0)
CUR(RTN,BDT,EDT,TOT) ; Current Status - stats - timeframe independent
"RTN","IBCNERP8",178,0)
; Input params: RTN-routine name as subs in ^TMP($J), **TOT-total recs
"RTN","IBCNERP8",179,0)
; searched - used only for status checks when the process is queued
"RTN","IBCNERP8",180,0)
; passed by reference
"RTN","IBCNERP8",181,0)
; Output vars: Set pcs of ^TMP($J,RTN,"CUR") as follows:
"RTN","IBCNERP8",182,0)
; 1=total Pending Resps (Transmitted-2)
"RTN","IBCNERP8",183,0)
; 2=total Queued Inqs (Ready to Transmit-1/Retry-6)
"RTN","IBCNERP8",184,0)
; 3=total Deferred Inqs (Hold-4)
"RTN","IBCNERP8",185,0)
; 4=Ins Cos w/o National ID
"RTN","IBCNERP8",186,0)
; 5=Payers w/eIV disabled locally
"RTN","IBCNERP8",187,0)
; 6=total user action required (symbol'='*' or '#' or '!' or '?' or '-')
"RTN","IBCNERP8",188,0)
; 7=total Man. Ver'd Ins Buf entries (symbol='*')
"RTN","IBCNERP8",189,0)
; 8=total eIV Processed Ver. (symbol='+')
"RTN","IBCNERP8",190,0)
; 9=total awaiting processing (symbol='?' or BLANK)
"RTN","IBCNERP8",191,0)
; 10=total Ins Buf entries w/symbol='#'
"RTN","IBCNERP8",192,0)
; 11=total Ins Buf entries w/symbol='!'
"RTN","IBCNERP8",193,0)
; 12=total Ins Buf entries w/symbol='?'
"RTN","IBCNERP8",194,0)
; 13=total Ins Buf entries w/symbol='-'
"RTN","IBCNERP8",195,0)
; 14=total Ins Buffer entries w/symbol not in ('*','#','!','?','-')
"RTN","IBCNERP8",196,0)
; 15=total Ins Buffer entries w/symbol='$'
"RTN","IBCNERP8",197,0)
; 16=total Ins Buffet entries w/symbol= % ; IB*2.0*621 - Added 16-21
"RTN","IBCNERP8",198,0)
; 17=total Insurance Buffer
"RTN","IBCNERP8",199,0)
; 18=Total Appointment
"RTN","IBCNERP8",200,0)
; 19=total Ele Ins Cov Discovery (EICD)
"RTN","IBCNERP8",201,0)
; 20=total EICD Triggered Einsurance Verification
"RTN","IBCNERP8",202,0)
; 21=total MBI Inquiry
"RTN","IBCNERP8",203,0)
; ^TMP($J,RTN,"CUR","FLAGS","A",Payer name,N) = active flag timestamp ^ active flag setting
"RTN","IBCNERP8",204,0)
; ^TMP($J,RTN,"CUR","FLAGS","T",Payer name,N) = trusted flag timestamp ^ trusted flag setting
"RTN","IBCNERP8",205,0)
;
"RTN","IBCNERP8",206,0)
; Init vars
"RTN","IBCNERP8",207,0)
N RIEN,TQIEN,ICIEN,IBIEN,RPTDATA,IEN,IBSYMBOL,PIECE,IBSTS,APPIEN
"RTN","IBCNERP8",208,0)
N PIEN,TMP,APPDATA,XDT,PDATA
"RTN","IBCNERP8",209,0)
;
"RTN","IBCNERP8",210,0)
S RPTDATA=""
"RTN","IBCNERP8",211,0)
;
"RTN","IBCNERP8",212,0)
; Responses pending (Transmitted - 2)
"RTN","IBCNERP8",213,0)
S RIEN=0
"RTN","IBCNERP8",214,0)
F S RIEN=$O(^IBCN(365,"AC",2,RIEN)) Q:'RIEN D Q:$G(ZTSTOP)
"RTN","IBCNERP8",215,0)
. S TOT=TOT+1
"RTN","IBCNERP8",216,0)
. I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",217,0)
. S $P(RPTDATA,U,1)=$P(RPTDATA,U,1)+1
"RTN","IBCNERP8",218,0)
. ; IB*2.0*621
"RTN","IBCNERP8",219,0)
. S TQIEN=$P($G(^IBCN(365,RIEN,0)),U,5)
"RTN","IBCNERP8",220,0)
. I TQIEN="" Q
"RTN","IBCNERP8",221,0)
. S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
"RTN","IBCNERP8",222,0)
. S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
"RTN","IBCNERP8",223,0)
. S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
"RTN","IBCNERP8",224,0)
. I IBTYP'="" D
"RTN","IBCNERP8",225,0)
. . I IBTYP=3 Q
"RTN","IBCNERP8",226,0)
. . ;I IBTYP=1 D Q ;IB*2.0*631
"RTN","IBCNERP8",227,0)
. . I IBTYP=7 S $P(RPTDATA,U,21)=$P($G(RPTDATA),U,21)+1 Q ; MBI Request``
"RTN","IBCNERP8",228,0)
. . I ("~1~5~6~"[("~"_IBTYP_"~")) S $P(RPTDATA,U,17)=$P($G(RPTDATA),U,17)+1 Q
"RTN","IBCNERP8",229,0)
. S:IBTYP=2 $P(RPTDATA,U,18)=$P($G(RPTDATA),U,18)+1 ; Appointment
"RTN","IBCNERP8",230,0)
. I IBTYP=4 D Q
"RTN","IBCNERP8",231,0)
. . I IBQUERY="I" S $P(RPTDATA,U,19)=$P($G(RPTDATA),U,19)+1 ; EICD Queries
"RTN","IBCNERP8",232,0)
. . I IBQUERY="V" S $P(RPTDATA,U,20)=$P($G(RPTDATA),U,20)+1 ; EICD Verification
"RTN","IBCNERP8",233,0)
. ; IB*2.0*621 - End IN Group
"RTN","IBCNERP8",234,0)
;
"RTN","IBCNERP8",235,0)
I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",236,0)
;
"RTN","IBCNERP8",237,0)
; Queued inquiries (Ready to Transmit - 1/Retry - 6) and
"RTN","IBCNERP8",238,0)
; Deferred inquiries (Hold - 4)
"RTN","IBCNERP8",239,0)
F IBSTS=1,6,4 D Q:$G(ZTSTOP)
"RTN","IBCNERP8",240,0)
. S TQIEN=0
"RTN","IBCNERP8",241,0)
. F S TQIEN=$O(^IBCN(365.1,"AC",IBSTS,TQIEN)) Q:'TQIEN D Q:$G(ZTSTOP)
"RTN","IBCNERP8",242,0)
. . S TOT=TOT+1
"RTN","IBCNERP8",243,0)
. . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
"RTN","IBCNERP8",244,0)
. . I IBSTS'=4 S $P(RPTDATA,U,2)=$P(RPTDATA,U,2)+1 Q
"RTN","IBCNERP8",245,0)
. . S $P(RPTDATA,U,3)=$P(RPTDATA,U,3)+1
"RTN","IBCNERP8",246,0)
;
"RTN","IBCNERP8",247,0)
I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",248,0)
;
"RTN","IBCNERP8",249,0)
; Payer stats
"RTN","IBCNERP8",250,0)
; Ins cos w/o National ID
"RTN","IBCNERP8",251,0)
S ICIEN=0,$P(RPTDATA,U,4)=0
"RTN","IBCNERP8",252,0)
F S ICIEN=$O(^DIC(36,ICIEN)) Q:'ICIEN D Q:$G(ZTSTOP)
"RTN","IBCNERP8",253,0)
. S TOT=TOT+1
"RTN","IBCNERP8",254,0)
. I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
"RTN","IBCNERP8",255,0)
. ; Exclude inactive
"RTN","IBCNERP8",256,0)
. S TMP=$$ACTIVE^IBCNEUT4(ICIEN) I 'TMP Q
"RTN","IBCNERP8",257,0)
. ; Exclude Medicaid, etc.
"RTN","IBCNERP8",258,0)
. I $$EXCLUDE^IBCNEUT4($P(TMP,U,2)) Q
"RTN","IBCNERP8",259,0)
. ; Does a NATIONAL ID exist?
"RTN","IBCNERP8",260,0)
. ; VA CBO defines 'No National ID' as lack of EDI IDs - fields (#36,3.02) & (#36,3.04) 3/4/14
"RTN","IBCNERP8",261,0)
. ; This is *NOT* a check for the 'VA NATIONAL ID' associated with the linked payer
"RTN","IBCNERP8",262,0)
. I ($$GET1^DIQ(36,ICIEN_",",3.02)="")&($$GET1^DIQ(36,ICIEN_",",3.04)="") S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1 Q
"RTN","IBCNERP8",263,0)
. Q
"RTN","IBCNERP8",264,0)
. ; Determine assoc Payer
"RTN","IBCNERP8",265,0)
. ;S PIEN=$P($G(^DIC(36,ICIEN,3)),U,10)
"RTN","IBCNERP8",266,0)
. ; Missing payer link
"RTN","IBCNERP8",267,0)
. ;I 'PIEN S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1 Q
"RTN","IBCNERP8",268,0)
. ; Does a VA NATIONAL ID exist?
"RTN","IBCNERP8",269,0)
. ;I $P($G(^IBE(365.12,PIEN,0)),U,2)'="" Q
"RTN","IBCNERP8",270,0)
. ;S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1
"RTN","IBCNERP8",271,0)
;
"RTN","IBCNERP8",272,0)
I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",273,0)
;
"RTN","IBCNERP8",274,0)
; eIV Payers disabled locally
"RTN","IBCNERP8",275,0)
S PIEN=0
"RTN","IBCNERP8",276,0)
F S PIEN=$O(^IBE(365.12,PIEN)) Q:'PIEN D Q:$G(ZTSTOP)
"RTN","IBCNERP8",277,0)
. S TOT=TOT+1
"RTN","IBCNERP8",278,0)
. I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",279,0)
. S PDATA=$G(^IBE(365.12,PIEN,0))
"RTN","IBCNERP8",280,0)
. ; Must have National ID
"RTN","IBCNERP8",281,0)
. I $P(PDATA,U,2)="" Q
"RTN","IBCNERP8",282,0)
. ; Get Payer app multiple IEN
"RTN","IBCNERP8",283,0)
. S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
"RTN","IBCNERP8",284,0)
. ; Must have eIV application
"RTN","IBCNERP8",285,0)
. I 'APPIEN Q
"RTN","IBCNERP8",286,0)
. ; Get Active/Trusted flag logs
"RTN","IBCNERP8",287,0)
. D GETFLAGS(PIEN,APPIEN,PDATA,BDT,EDT,.RPTDATA)
"RTN","IBCNERP8",288,0)
. ;
"RTN","IBCNERP8",289,0)
. S APPDATA=$G(^IBE(365.12,PIEN,1,APPIEN,0))
"RTN","IBCNERP8",290,0)
. ; Must be Nationally Active
"RTN","IBCNERP8",291,0)
. I '$P(APPDATA,U,2) Q
"RTN","IBCNERP8",292,0)
. ; Must not be Locally Active
"RTN","IBCNERP8",293,0)
. I $P(APPDATA,U,3) Q
"RTN","IBCNERP8",294,0)
. S $P(RPTDATA,U,5)=$P(RPTDATA,U,5)+1
"RTN","IBCNERP8",295,0)
;
"RTN","IBCNERP8",296,0)
I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",297,0)
;
"RTN","IBCNERP8",298,0)
; Buffer stats
"RTN","IBCNERP8",299,0)
; Loop thru the Ins Buffer File (#355.33)
"RTN","IBCNERP8",300,0)
S IBIEN=0,XDT=0
"RTN","IBCNERP8",301,0)
F S XDT=$O(^IBA(355.33,"AEST","E",XDT)) Q:XDT="" D Q:$G(ZTSTOP)
"RTN","IBCNERP8",302,0)
. F S IBIEN=$O(^IBA(355.33,"AEST","E",XDT,IBIEN)) Q:IBIEN="" D Q:$G(ZTSTOP)
"RTN","IBCNERP8",303,0)
. . S TOT=TOT+1
"RTN","IBCNERP8",304,0)
. . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",305,0)
. . S IBSYMBOL=$$SYMBOL^IBCNBLL(IBIEN)
"RTN","IBCNERP8",306,0)
. . ; Determine piece to update based on symbol
"RTN","IBCNERP8",307,0)
. . ; ('*') = Man. Verified, ('#','!','-','?',blank/null) = eIV Processing
"RTN","IBCNERP8",308,0)
. . ; ('+') = eIV Processed, ('$') = Escalated, Active policy
"RTN","IBCNERP8",309,0)
. . ; IB*2.0*506/taz Node 15 added.
"RTN","IBCNERP8",310,0)
. . ; IB*2.0*621/ Node 16 Added.
"RTN","IBCNERP8",311,0)
. . S PIECE=$S(IBSYMBOL="*":7,IBSYMBOL="+":8,IBSYMBOL="#":10,IBSYMBOL="!":11,IBSYMBOL="-":13,IBSYMBOL="?":12,IBSYMBOL="$":15,IBSYMBOL="%":16,1:14)
"RTN","IBCNERP8",312,0)
. . I PIECE=12!(PIECE=14) S $P(RPTDATA,U,9)=$P($G(RPTDATA),U,9)+1
"RTN","IBCNERP8",313,0)
. . E S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1
"RTN","IBCNERP8",314,0)
. . S $P(RPTDATA,U,PIECE)=$P($G(RPTDATA),U,PIECE)+1
"RTN","IBCNERP8",315,0)
;
"RTN","IBCNERP8",316,0)
I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",317,0)
;
"RTN","IBCNERP8",318,0)
; Save data to global
"RTN","IBCNERP8",319,0)
M ^TMP($J,RTN,"CUR")=RPTDATA
"RTN","IBCNERP8",320,0)
;
"RTN","IBCNERP8",321,0)
CURX ; CUR exit point
"RTN","IBCNERP8",322,0)
Q
"RTN","IBCNERP8",323,0)
;
"RTN","IBCNERP8",324,0)
GETFLAGS(PIEN,APPIEN,PDATA,BDT,EDT,RPTDATA) ; get Active/Trusted flag logs
"RTN","IBCNERP8",325,0)
; PIEN - Payer ien in file 365.12
"RTN","IBCNERP8",326,0)
; APPIEN - Application ien in subfile 365.121
"RTN","IBCNERP8",327,0)
; PDATA - 0 node of Payer file entry
"RTN","IBCNERP8",328,0)
; BDT - Start date/time
"RTN","IBCNERP8",329,0)
; EDT - End date/time
"RTN","IBCNERP8",330,0)
; RPTDATA - output array, passed by reference
"RTN","IBCNERP8",331,0)
;
"RTN","IBCNERP8",332,0)
N FLAGS,IEN,PNAME,TYP,TM,VAL,Z
"RTN","IBCNERP8",333,0)
S PNAME=$P(PDATA,U)
"RTN","IBCNERP8",334,0)
F TYP=2,3 S TM=EDT,Z=0 F S TM=$O(^IBE(365.12,PIEN,1,APPIEN,TYP,"B",TM),-1) Q:TM=""!($$FMDIFF^XLFDT(TM,BDT,2)'>0) D
"RTN","IBCNERP8",335,0)
.S IEN=$O(^IBE(365.12,PIEN,1,APPIEN,TYP,"B",TM,""))
"RTN","IBCNERP8",336,0)
.S VAL=$$EXTERNAL^DILFD("365.121"_TYP,.02,,$P(^IBE(365.12,PIEN,1,APPIEN,TYP,IEN,0),U,2))
"RTN","IBCNERP8",337,0)
.S Z=Z+1,RPTDATA("FLAGS",$S(TYP=2:"A",1:"T"),PNAME,Z)=$$FMTE^XLFDT(TM,"5ZS")_"^"_VAL
"RTN","IBCNERP8",338,0)
.Q
"RTN","IBCNERP8",339,0)
Q
"RTN","IBCNERTQ")
0^4^B51002672^B48024033
"RTN","IBCNERTQ",1,0)
IBCNERTQ ;ALB/BI - Real-time Insurance Verification ;15-OCT-2015
"RTN","IBCNERTQ",2,0)
;;2.0;INTEGRATED BILLING;**438,467,497,549,582,593,601,631**;21-MAR-94;Build 11
"RTN","IBCNERTQ",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNERTQ",4,0)
Q
"RTN","IBCNERTQ",5,0)
;
"RTN","IBCNERTQ",6,0)
TRIG(N2) ; Called by triggers in the INSURANCE BUFFER FILE Dictionary (355.33)
"RTN","IBCNERTQ",7,0)
; Fields: 20.01 - INSURANCE COMPANY NAME
"RTN","IBCNERTQ",8,0)
; 90.01 - GROUP NAME
"RTN","IBCNERTQ",9,0)
; 90.02 - GROUP NUMBER
"RTN","IBCNERTQ",10,0)
; 60.01 - PATIENT NAME
"RTN","IBCNERTQ",11,0)
; 90.03 - SUBSCRIBER ID
"RTN","IBCNERTQ",12,0)
; 60.08 - INSURED'S DOB
"RTN","IBCNERTQ",13,0)
; 62.01 - PATIENT ID
"RTN","IBCNERTQ",14,0)
;
"RTN","IBCNERTQ",15,0)
; To make a request for Real Time Verification
"RTN","IBCNERTQ",16,0)
; The following fields must contain data.
"RTN","IBCNERTQ",17,0)
; 20.01 - INSURANCE COMPANY NAME
"RTN","IBCNERTQ",18,0)
; 60.01 - PATIENT NAME
"RTN","IBCNERTQ",19,0)
; 90.03 - SUBSCRIBER ID (if patient is the subscriber)
"RTN","IBCNERTQ",20,0)
; 60.08 - INSURED'S DOB (if patient is not the subscriber)
"RTN","IBCNERTQ",21,0)
; 62.01 - PATIENT ID (if patient is not the subscriber)
"RTN","IBCNERTQ",22,0)
;
"RTN","IBCNERTQ",23,0)
;
"RTN","IBCNERTQ",24,0)
N TQIEN,TQN0,NODE20,NODE60,NODE90,QF,N4,PTID,SUBID,MGRP,DFN,PREL
"RTN","IBCNERTQ",25,0)
N RESPONSE S RESPONSE=0
"RTN","IBCNERTQ",26,0)
; Protect the FileMan variables.
"RTN","IBCNERTQ",27,0)
N DA,DB,DC,DH,DI,DK,DL,DM,DP,DQ,DR,INI,MR,NX,UP
"RTN","IBCNERTQ",28,0)
;
"RTN","IBCNERTQ",29,0)
I N2="" Q RESPONSE
"RTN","IBCNERTQ",30,0)
;IB*582/HAN - Do not allow entries to process if the user is INTERFACE,IB EIV
"RTN","IBCNERTQ",31,0)
N EIVDUZ S EIVDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
"RTN","IBCNERTQ",32,0)
;IB*2.0*593/HN - Added to allow nightly extract entries to go out immediately.
"RTN","IBCNERTQ",33,0)
I $G(IDUZ)'="",IDUZ=EIVDUZ,$G(CALLEDBY)'="",CALLEDBY="IBCNEHL1" Q RESPONSE
"RTN","IBCNERTQ",34,0)
;IB*582 - End
"RTN","IBCNERTQ",35,0)
S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNERTQ",36,0)
S NODE20=$G(^IBA(355.33,N2,20))
"RTN","IBCNERTQ",37,0)
S NODE60=$G(^IBA(355.33,N2,60))
"RTN","IBCNERTQ",38,0)
S NODE90=$G(^IBA(355.33,N2,90))
"RTN","IBCNERTQ",39,0)
S PREL=$P(NODE60,U,14)
"RTN","IBCNERTQ",40,0)
I $P(NODE20,U,1)="" Q RESPONSE ;INSURANCE COMPANY NAME
"RTN","IBCNERTQ",41,0)
I $P(NODE60,U,1)="" Q RESPONSE ;PATIENT NAME
"RTN","IBCNERTQ",42,0)
I $P(NODE90,U,3)="" Q RESPONSE ;SUBSCRIBER ID
"RTN","IBCNERTQ",43,0)
; exclude dependent inquiries w/o patient id or DOB
"RTN","IBCNERTQ",44,0)
I PREL'=18,PREL'="",($P($G(^IBA(355.33,N2,62)),U)=""!($P(NODE60,U,8)="")) Q RESPONSE
"RTN","IBCNERTQ",45,0)
; exclude ePharmacy buffer entries
"RTN","IBCNERTQ",46,0)
I $G(IBNCPDPELIG) Q RESPONSE ; variable set in ^IBNCPDP3
"RTN","IBCNERTQ",47,0)
I $P($G(^IBA(355.33,N2,0)),U,17)'="" Q RESPONSE
"RTN","IBCNERTQ",48,0)
;
"RTN","IBCNERTQ",49,0)
; prevent HMS entries from creating inquiries
"RTN","IBCNERTQ",50,0)
N PTR S PTR=+$P($G(^IBA(355.33,N2,0)),U,3)
"RTN","IBCNERTQ",51,0)
I PTR,$P($G(^IBE(355.12,PTR,0)),U,2)="HMS",PREL="" Q RESPONSE
"RTN","IBCNERTQ",52,0)
;
"RTN","IBCNERTQ",53,0)
; Quit if a waiting transaction exists in file #365.1
"RTN","IBCNERTQ",54,0)
S PTID=$P(NODE60,U,1)
"RTN","IBCNERTQ",55,0)
S SUBID=$P(NODE90,U,3)
"RTN","IBCNERTQ",56,0)
S QF=0,N4=""
"RTN","IBCNERTQ",57,0)
F S N4=$O(^IBCN(365.1,"E",PTID,N4)) Q:N4="" Q:QF=1 D
"RTN","IBCNERTQ",58,0)
.S TQN0=$G(^IBCN(365.1,N4,0))
"RTN","IBCNERTQ",59,0)
.; don't send again if there's an entry in the queue with the same subscriber id, same buffer entry, and
"RTN","IBCNERTQ",60,0)
.; transmission status other than "response received" or "cancelled"
"RTN","IBCNERTQ",61,0)
.I $P(TQN0,U,5)=N2,".3.7."'[("."_$P(TQN0,U,4)_"."),$P(TQN0,U,16)=SUBID S QF=1 Q
"RTN","IBCNERTQ",62,0)
.Q
"RTN","IBCNERTQ",63,0)
I QF=1 Q RESPONSE ; DON'T SEND AGAIN.
"RTN","IBCNERTQ",64,0)
;
"RTN","IBCNERTQ",65,0)
; Quit if there is a lock on patient and policy in file #355.33
"RTN","IBCNERTQ",66,0)
L +^IBA(355.33,N2):1 I '$T Q RESPONSE ; RECORD LOCKED By Another Process
"RTN","IBCNERTQ",67,0)
;
"RTN","IBCNERTQ",68,0)
;Store Service Type Code in BUFFER file #355.33 just before sending to EIV TRANSMISSION QUEUE
"RTN","IBCNERTQ",69,0)
I +$G(^IBA(355.33,N2,80))'>0 D SETSTC(N2)
"RTN","IBCNERTQ",70,0)
;
"RTN","IBCNERTQ",71,0)
; Save and clear the dictionary 355.33 temporary error global, ^TMP("DIERR",$J)
"RTN","IBCNERTQ",72,0)
K ^TMP("IBCNERTQ","DIERR",$J)
"RTN","IBCNERTQ",73,0)
M ^TMP("IBCNERTQ","DIERR",$J)=^TMP("DIERR",$J)
"RTN","IBCNERTQ",74,0)
K ^TMP("DIERR",$J)
"RTN","IBCNERTQ",75,0)
;
"RTN","IBCNERTQ",76,0)
; if buffer entry is currently being edited, set the flag and quit
"RTN","IBCNERTQ",77,0)
I $G(^TMP("IBCNERTQ",$J,N2,"LOCK"))=1 S ^TMP("IBCNERTQ",$J,N2,"TRIGGER")=1 G ENDTRIG
"RTN","IBCNERTQ",78,0)
;
"RTN","IBCNERTQ",79,0)
; Sending to the EIV TRANSMISION QUEUE.
"RTN","IBCNERTQ",80,0)
S TQIEN=$$IBE(N2) I 'TQIEN G ENDTRIG
"RTN","IBCNERTQ",81,0)
; Load and Send HL7 Message
"RTN","IBCNERTQ",82,0)
S RESPONSE=$$PROCSEND(TQIEN)
"RTN","IBCNERTQ",83,0)
;
"RTN","IBCNERTQ",84,0)
ENDTRIG ; Final Clean Up.
"RTN","IBCNERTQ",85,0)
;
"RTN","IBCNERTQ",86,0)
; Restore the dictionary 355.33 temporary error global, ^TMP("DIERR",$J)
"RTN","IBCNERTQ",87,0)
K ^TMP("DIERR",$J)
"RTN","IBCNERTQ",88,0)
M ^TMP("DIERR",$J)=^TMP("IBCNERTQ","DIERR",$J)
"RTN","IBCNERTQ",89,0)
K ^TMP("IBCNERTQ","DIERR",$J)
"RTN","IBCNERTQ",90,0)
;
"RTN","IBCNERTQ",91,0)
; Remove Dictionary Entry Lock.
"RTN","IBCNERTQ",92,0)
L -^IBA(355.33,N2)
"RTN","IBCNERTQ",93,0)
Q RESPONSE
"RTN","IBCNERTQ",94,0)
;
"RTN","IBCNERTQ",95,0)
IBE(IEN) ; Insurance Buffer Extract
"RTN","IBCNERTQ",96,0)
N FRESHDAY,FRESHDT,INSNAME,ISMBI,ISYMBOL,MCAREFLG,OVRFRESH,PAYERID,PAYERSTR
"RTN","IBCNERTQ",97,0)
N PIEN,QUEUED,SRVICEDT,STATIEN,SYMBOL,TQDT,TQIENS,TQOK
"RTN","IBCNERTQ",98,0)
;
"RTN","IBCNERTQ",99,0)
S QUEUED=0
"RTN","IBCNERTQ",100,0)
S FRESHDAY=$P($G(^IBE(350.9,1,51)),U,1) ;System freshness days
"RTN","IBCNERTQ",101,0)
;
"RTN","IBCNERTQ",102,0)
; Get symbol, if symbol'=" " OR "!" OR "#" then quit
"RTN","IBCNERTQ",103,0)
S ISYMBOL=$$SYMBOL^IBCNBLL(IEN) ;Insurance buffer symbol
"RTN","IBCNERTQ",104,0)
I (ISYMBOL'=" ")&(ISYMBOL'="!")&(ISYMBOL'="#") Q QUEUED
"RTN","IBCNERTQ",105,0)
;
"RTN","IBCNERTQ",106,0)
; IB*2.0*549 - Quit if Realtime Extract Master switch is off
"RTN","IBCNERTQ",107,0)
; Note: Checking here instead of the top of TRIG to check for above error conditions first
"RTN","IBCNERTQ",108,0)
Q:$$GET1^DIQ(350.9,"1,",51.27,"I")="N" 0
"RTN","IBCNERTQ",109,0)
;
"RTN","IBCNERTQ",110,0)
; Get the eIV STATUS IEN and quit for response related errors
"RTN","IBCNERTQ",111,0)
S STATIEN=+$P($G(^IBA(355.33,IEN,0)),U,12)
"RTN","IBCNERTQ",112,0)
I ",11,12,15,"[(","_STATIEN_",") Q QUEUED ;Prevent update for response errors
"RTN","IBCNERTQ",113,0)
;
"RTN","IBCNERTQ",114,0)
S OVRFRESH=$P($G(^IBA(355.33,IEN,0)),U,13) ;Freshness OvrRd flag
"RTN","IBCNERTQ",115,0)
S DFN=$P($G(^IBA(355.33,IEN,60)),U,1) ;Patient DFN
"RTN","IBCNERTQ",116,0)
Q:DFN="" QUEUED
"RTN","IBCNERTQ",117,0)
I $P($G(^DPT(DFN,0)),U,21) Q QUEUED ;Exclude if test patient
"RTN","IBCNERTQ",118,0)
;
"RTN","IBCNERTQ",119,0)
S PDOD=$P($G(^DPT(DFN,.35)),U,1)\1 ;Patient's date of death
"RTN","IBCNERTQ",120,0)
S SRVICEDT=+$P($G(^IBA(355.33,IEN,0)),U,18) S:'SRVICEDT SRVICEDT=DT ; Service Date
"RTN","IBCNERTQ",121,0)
;
"RTN","IBCNERTQ",122,0)
; IB*2.0*549 Removed following line
"RTN","IBCNERTQ",123,0)
;I PDOD,PDOD<SRVICEDT S SRVICEDT=PDOD
"RTN","IBCNERTQ",124,0)
S FRESHDT=$$FMADD^XLFDT(SRVICEDT,-FRESHDAY)
"RTN","IBCNERTQ",125,0)
S PAYERSTR=$$INSERROR^IBCNEUT3("B",IEN) ;Payer String
"RTN","IBCNERTQ",126,0)
S PAYERID=$P(PAYERSTR,U,3),PIEN=$P(PAYERSTR,U,2) ;Payer ID
"RTN","IBCNERTQ",127,0)
S SYMBOL=+PAYERSTR ;Payer Symbol
"RTN","IBCNERTQ",128,0)
I '$$PYRACTV^IBCNEDE7(PIEN) Q QUEUED ;Payer is not nationally active
"RTN","IBCNERTQ",129,0)
;
"RTN","IBCNERTQ",130,0)
; If payer symbol is returned set symbol in Ins. Buffer and quit
"RTN","IBCNERTQ",131,0)
I SYMBOL D BUFF^IBCNEUT2(IEN,SYMBOL) Q QUEUED
"RTN","IBCNERTQ",132,0)
;
"RTN","IBCNERTQ",133,0)
D CLEAR^IBCNEUT4(IEN) ;Remove any existing symbol
"RTN","IBCNERTQ",134,0)
;
"RTN","IBCNERTQ",135,0)
; If no payer ID or no payer IEN is returned quit
"RTN","IBCNERTQ",136,0)
I (PAYERID="")!('PIEN) Q QUEUED
"RTN","IBCNERTQ",137,0)
;
"RTN","IBCNERTQ",138,0)
; Update service date and freshness date based on payer's allowed
"RTN","IBCNERTQ",139,0)
; date range
"RTN","IBCNERTQ",140,0)
D UPDDTS^IBCNEDE6(PIEN,.SRVICEDT,.FRESHDT)
"RTN","IBCNERTQ",141,0)
;
"RTN","IBCNERTQ",142,0)
; Update service dates for inquiries to be transmitted
"RTN","IBCNERTQ",143,0)
D TQUPDSV^IBCNEUT5(DFN,PIEN,SRVICEDT)
"RTN","IBCNERTQ",144,0)
;
"RTN","IBCNERTQ",145,0)
; Allow only one MEDICARE transmission per patient
"RTN","IBCNERTQ",146,0)
; IB*2*601/DM
"RTN","IBCNERTQ",147,0)
;S INSNAME=$P($G(^IBA(355.33,IEN,20)),U)
"RTN","IBCNERTQ",148,0)
;I INSNAME["MEDICARE",$G(MCAREFLG(DFN)) Q QUEUED
"RTN","IBCNERTQ",149,0)
S INSNAME=$$GET1^DIQ(355.33,IEN_",","INSURANCE COMPANY NAME")
"RTN","IBCNERTQ",150,0)
S ISMBI=$$MBICHK^IBCNEUT7(IEN) ;IB*2.0*631/TAZ - Set the MBI Check into a variable since it is used in multiple places.
"RTN","IBCNERTQ",151,0)
I 'ISMBI,INSNAME["MEDICARE",$G(MCAREFLG(DFN)) Q QUEUED
"RTN","IBCNERTQ",152,0)
; make sure that entries have pat. relationship set to "self"
"RTN","IBCNERTQ",153,0)
D SETREL^IBCNEDE1(IEN)
"RTN","IBCNERTQ",154,0)
;
"RTN","IBCNERTQ",155,0)
; If freshness override flag is set, file to TQ and quit
"RTN","IBCNERTQ",156,0)
I OVRFRESH=1!ISMBI D Q $G(TQIEN)
"RTN","IBCNERTQ",157,0)
. ;IB*2.0*631/TAZ - Changed logic to call new TQ
"RTN","IBCNERTQ",158,0)
. ;N DIE,DISYS,SUBID,WHICH,X,Y
"RTN","IBCNERTQ",159,0)
. ;S SUBID=$$GET1^DIQ(365.1,TQIEN_",",.16,"I"),WHICH=$S(SUBID="MBIRequest":7,1:5)
"RTN","IBCNERTQ",160,0)
. N DIE,DISYS,WHICH,X,Y
"RTN","IBCNERTQ",161,0)
. S WHICH=$S(ISMBI:7,1:5)
"RTN","IBCNERTQ",162,0)
. S FDA(355.33,IEN_",",.13)="" D FILE^DIE("","FDA") K FDA
"RTN","IBCNERTQ",163,0)
. S:INSNAME["MEDICARE" MCAREFLG(DFN)=1 D TQ^IBCNERTU(WHICH,IEN,FRESHDT,DFN,PIEN,OVRFRESH,SRVICEDT)
"RTN","IBCNERTQ",164,0)
; Check the existing TQ entries to confirm that this buffer IEN is
"RTN","IBCNERTQ",165,0)
; not included
"RTN","IBCNERTQ",166,0)
S (TQDT,TQIENS)="",TQOK=1
"RTN","IBCNERTQ",167,0)
I ISYMBOL'="#" F S TQDT=$O(^IBCN(365.1,"AD",DFN,PIEN,TQDT)) Q:'TQDT!'TQOK D
"RTN","IBCNERTQ",168,0)
. F S TQIENS=$O(^IBCN(365.1,"AD",DFN,PIEN,TQDT,TQIENS)) Q:'TQIENS!'TQOK D
"RTN","IBCNERTQ",169,0)
.. I $P($G(^IBCN(365.1,TQIENS,0)),U,5)=IEN S TQOK=0 Q
"RTN","IBCNERTQ",170,0)
I TQOK S:INSNAME["MEDICARE" MCAREFLG(DFN)=1 D TQ^IBCNERTU(6,IEN,FRESHDT,DFN,PIEN,OVRFRESH,SRVICEDT) ;IB*2.0*631/TAZ
"RTN","IBCNERTQ",171,0)
Q $G(TQIEN)
"RTN","IBCNERTQ",172,0)
;
"RTN","IBCNERTQ",173,0)
PROCSEND(TQIEN) ; Make call to PROC^IBCNEDEP to build the HL7 message. Then send the Message.
"RTN","IBCNERTQ",174,0)
N BUFF,CNT,D,D0,DFN,DIC,DIE,DILOCKTM,DISYS,EXT
"RTN","IBCNERTQ",175,0)
N FRDT,GT1,HCT,HL,HLCDOM,HLCINS,HLCS,HLCSTCP,HLDOM,HLECH
"RTN","IBCNERTQ",176,0)
N HLFS,HLHDR,HLINST,HLIP,HLN,HLP,HLPARAM,HLPROD,HLQ,HLRESLT
"RTN","IBCNERTQ",177,0)
N HLSAN,HLTYPE,HLX,IBCNHLP,IEN,IHCNT,IN1,IRIEN,MSGID,TOT
"RTN","IBCNERTQ",178,0)
N NRETR,NTRAN,OVRIDE,PATID,PAYR,PID,QUERY,RSTYPE,SRVDT,STA
"RTN","IBCNERTQ",179,0)
N SUB4,SUBID,TRANSR,U,VACNTRY,VNUM,X,ZMID
"RTN","IBCNERTQ",180,0)
;
"RTN","IBCNERTQ",181,0)
K ^TMP("HLS",$J)
"RTN","IBCNERTQ",182,0)
S IEN=TQIEN
"RTN","IBCNERTQ",183,0)
I $D(DT)=0 N DT S DT=$$DT^XLFDT
"RTN","IBCNERTQ",184,0)
S U="^",CNT=0,TOT=0,IHCNT=0
"RTN","IBCNERTQ",185,0)
S QUERY=$P($G(^IBCN(365.1,IEN,0)),U,11)
"RTN","IBCNERTQ",186,0)
I QUERY="V" S VNUM=3
"RTN","IBCNERTQ",187,0)
I $D(VNUM)=0 Q 0
"RTN","IBCNERTQ",188,0)
;
"RTN","IBCNERTQ",189,0)
; IB*2.0*549 - quit if test site and not a valid test case
"RTN","IBCNERTQ",190,0)
Q:'$$XMITOK^IBCNETST(IEN) 0
"RTN","IBCNERTQ",191,0)
;
"RTN","IBCNERTQ",192,0)
; Initialize HL7 variables protocol for Verifications
"RTN","IBCNERTQ",193,0)
S IBCNHLP="IBCNE IIV RQV OUT"
"RTN","IBCNERTQ",194,0)
D INIT^IBCNEHLO
"RTN","IBCNERTQ",195,0)
D PROC^IBCNEDEP
"RTN","IBCNERTQ",196,0)
D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
"RTN","IBCNERTQ",197,0)
; If not successful
"RTN","IBCNERTQ",198,0)
I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ Q 0
"RTN","IBCNERTQ",199,0)
; If successful
"RTN","IBCNERTQ",200,0)
D SCC^IBCNEDEQ
"RTN","IBCNERTQ",201,0)
K ^TMP("HLS",$J)
"RTN","IBCNERTQ",202,0)
;
"RTN","IBCNERTQ",203,0)
I $G(^TMP("IBCNEQUDTS",$J)) D
"RTN","IBCNERTQ",204,0)
. S DA=IEN,DIE="^IBCN(365.1,",DR="3.01////^S X=$$NOW^XLFDT" D ^DIE
"RTN","IBCNERTQ",205,0)
;
"RTN","IBCNERTQ",206,0)
Q 1
"RTN","IBCNERTQ",207,0)
;
"RTN","IBCNERTQ",208,0)
SETSTC(BUFF) ; set service type code
"RTN","IBCNERTQ",209,0)
N DIE,DA,DR,X,Y
"RTN","IBCNERTQ",210,0)
I '+$G(BUFF) Q
"RTN","IBCNERTQ",211,0)
; Define Service Type Code (STC) to be sent with Insurance Inquiry
"RTN","IBCNERTQ",212,0)
S DIE="^IBA(355.33,",DA=BUFF
"RTN","IBCNERTQ",213,0)
S DR="80.01////"_$P($G(^IBE(350.9,1,60)),U)
"RTN","IBCNERTQ",214,0)
D ^DIE
"RTN","IBCNERTQ",215,0)
Q
"RTN","IBCNERTU")
0^3^B8303401^n/a
"RTN","IBCNERTU",1,0)
IBCNERTU ;AITC/TAZ - eIV Processing Real-Time Inquiries ;13-MAR-19
"RTN","IBCNERTU",2,0)
;;2.0;INTEGRATED BILLING;**631**;;Build 11;
"RTN","IBCNERTU",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNERTU",4,0)
;
"RTN","IBCNERTU",5,0)
TQ(WEXT,IEN,FRESHDT,DFN,PIEN,OVRFRESH,SRVICEDT) ; Determine how many entries to create in the TQ file and set entries
"RTN","IBCNERTU",6,0)
;
"RTN","IBCNERTU",7,0)
;INPUT:
"RTN","IBCNERTU",8,0)
; WEXT - Which Extract Internal Value (#365.1,.1)
"RTN","IBCNERTU",9,0)
; IEN - internal # for the buffer record in file #355.33
"RTN","IBCNERTU",10,0)
; FRESHDT - (Service Date - Freshday)- used to check verified date
"RTN","IBCNERTU",11,0)
; DFN - Patient's IEN (file 2)
"RTN","IBCNERTU",12,0)
; PIEN - Payer's IEN (file 365.12)
"RTN","IBCNERTU",13,0)
; OVRFRESH - Freshness OvrRd flag (#355.33,13)
"RTN","IBCNERTU",14,0)
; SRVICEDT- Service date (#355.33,18)
"RTN","IBCNERTU",15,0)
;
"RTN","IBCNERTU",16,0)
N BSID,PASSBUF,PATID,PREL,SID,SIDACT,SIDARRAY,SIDDATA
"RTN","IBCNERTU",17,0)
;
"RTN","IBCNERTU",18,0)
K SIDARRAY
"RTN","IBCNERTU",19,0)
S BSID=$$GET1^DIQ(355.33,IEN_",",90.03) ; Subscriber ID from buffer
"RTN","IBCNERTU",20,0)
S PATID=$$GET1^DIQ(355.33,IEN_",",62.01) ; Patient ID from buffer
"RTN","IBCNERTU",21,0)
S PREL=$$GET1^DIQ(355.33,IEN_",",60.14,"I") ; Pat. relationship from buffer
"RTN","IBCNERTU",22,0)
S SIDDATA=$$SIDCHK^IBCNEDE5(PIEN,DFN,BSID,.SIDARRAY,FRESHDT) ;determine rules to follow
"RTN","IBCNERTU",23,0)
S SIDACT=$P(SIDDATA,U,1)
"RTN","IBCNERTU",24,0)
;
"RTN","IBCNERTU",25,0)
I SIDACT=3 D BUFF^IBCNEUT2(IEN,18) Q ; update buffer w/ bang & quit - no subscriber id
"RTN","IBCNERTU",26,0)
I PREL'=18 D Q ; Not Equal to Self/Patient
"RTN","IBCNERTU",27,0)
.I PATID="" D BUFF^IBCNEUT2(IEN,23) Q ; update buffer w/ bang & quit - no patient id
"RTN","IBCNERTU",28,0)
.D SET(IEN,OVRFRESH,1,"") ; set TQ entry
"RTN","IBCNERTU",29,0)
.Q
"RTN","IBCNERTU",30,0)
S SID=""
"RTN","IBCNERTU",31,0)
F S SID=$O(SIDARRAY(SID)) Q:SID="" D:$P(SID,"_")'="" SET(IEN,OVRFRESH,1,$P(SID,"_")) ; set TQ w/ 'Pass Buffer' flag
"RTN","IBCNERTU",32,0)
I SIDACT=4 D SET(IEN,OVRFRESH,1,"") ; set TQ w/ 'Pass Buffer' flag w/ blank subscriber ID
"RTN","IBCNERTU",33,0)
Q
"RTN","IBCNERTU",34,0)
;
"RTN","IBCNERTU",35,0)
;
"RTN","IBCNERTU",36,0)
SET(BUFFIEN,OVRFRESH,PASSBUF,SID1) ; Set data and check if set already
"RTN","IBCNERTU",37,0)
N DATA1,DATA2,DATA5,IBMBI,ORIG
"RTN","IBCNERTU",38,0)
D RET(.ORIG)
"RTN","IBCNERTU",39,0)
;
"RTN","IBCNERTU",40,0)
; The hard coded '1' in the 3rd piece of DATA1 sets the Transmission
"RTN","IBCNERTU",41,0)
; status of file 365.1 to "Ready to Transmit"
"RTN","IBCNERTU",42,0)
S DATA1=DFN_U_PIEN_U_1_U_$G(BUFFIEN)_U_SID1_U_FRESHDT_U_PASSBUF ; SETTQ parameter 1
"RTN","IBCNERTU",43,0)
S $P(DATA1,U,8)=PATID
"RTN","IBCNERTU",44,0)
;
"RTN","IBCNERTU",45,0)
S DATA2=WEXT_U_"V"_U_SRVICEDT_U_"" ; SETTQ parameter 2
"RTN","IBCNERTU",46,0)
;
"RTN","IBCNERTU",47,0)
S DATA5=$$GET1^DIQ(355.33,BUFFIEN_",",.03,"I") ;copy SOI IEN to TQ
"RTN","IBCNERTU",48,0)
S TQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,ORIG,$G(OVRFRESH),DATA5) ; File TQ entry
"RTN","IBCNERTU",49,0)
;
"RTN","IBCNERTU",50,0)
Q
"RTN","IBCNERTU",51,0)
;
"RTN","IBCNERTU",52,0)
RET(ORIG) ; Record Retrieval - Insurance Buffer
"RTN","IBCNERTU",53,0)
;
"RTN","IBCNERTU",54,0)
S ORIG=$$GET1^DIQ(355.33,IEN_",",20.01) ;Original ins. co.
"RTN","IBCNERTU",55,0)
S ORIG=ORIG_U_$$GET1^DIQ(355.33,IEN_",",90.02) ;Original group number
"RTN","IBCNERTU",56,0)
S ORIG=ORIG_U_$$GET1^DIQ(355.33,IEN_",",90.01) ;Original group name
"RTN","IBCNERTU",57,0)
S ORIG=ORIG_U_$$GET1^DIQ(355.33,IEN_",",90.03) ;; Original subscriber ID
"RTN","IBCNERTU",58,0)
Q
"RTN","IBCNERTU",59,0)
;
"RTN","IBCNRDV")
0^14^B146805068^B144659738
"RTN","IBCNRDV",1,0)
IBCNRDV ;OAKFO/ELZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;27-MAR-03
"RTN","IBCNRDV",2,0)
;;2.0;INTEGRATED BILLING;**214,231,361,371,452,593,631**;21-MAR-94;Build 11
"RTN","IBCNRDV",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNRDV",4,0)
;
"RTN","IBCNRDV",5,0)
; This routine is used to exchange insurance information between
"RTN","IBCNRDV",6,0)
; facilities.
"RTN","IBCNRDV",7,0)
OPT ; Menu option entry point. This is used to select a patient to request
"RTN","IBCNRDV",8,0)
; information about from the remote treating facilities.
"RTN","IBCNRDV",9,0)
N DFN,DIC,X,Y,DTOUT,DUOUT,IBT,%,%Y,IBX,VADM,IBB,IBD,IBH,IBI,IBICN,IBR,IBRZ,IBX,IBY,IBZ,IBWAIT,IBL,DO,IBTYPE,IB1
"RTN","IBCNRDV",10,0)
;
"RTN","IBCNRDV",11,0)
; prompt for patient
"RTN","IBCNRDV",12,0)
AGAIN S DIC="^DPT(",DIC(0)="AEMNQ" D ^DIC Q:Y<1 S DFN=+Y
"RTN","IBCNRDV",13,0)
;
"RTN","IBCNRDV",14,0)
BACKGND ; background/tasked entry point
"RTN","IBCNRDV",15,0)
; IBTYPE is being used as a flag to indicate this is running in background
"RTN","IBCNRDV",16,0)
;
"RTN","IBCNRDV",17,0)
; look up treating facilities
"RTN","IBCNRDV",18,0)
K IBT S IBT=$$TFL^IBARXMU(DFN,.IBT)
"RTN","IBCNRDV",19,0)
I IBT<1,'$D(IBTYPE) W !!,"This patient has no remote treating facilities to query." G AGAIN
"RTN","IBCNRDV",20,0)
I IBT<1 Q
"RTN","IBCNRDV",21,0)
;
"RTN","IBCNRDV",22,0)
; display and verify we want to do this
"RTN","IBCNRDV",23,0)
I '$D(IBTYPE) D DEM^VADPT W !!,"The patient ",VADM(1)," has the following ",IBT," remote facilitie(s)",! S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 W !?10,$P(IBT(IBX),"^",2)
"RTN","IBCNRDV",24,0)
I '$D(IBTYPE) W !!,"Do you want to perform this Remote Query" S %=1 D YN^DICN G:%'=1 AGAIN
"RTN","IBCNRDV",25,0)
;
"RTN","IBCNRDV",26,0)
; get ICN
"RTN","IBCNRDV",27,0)
S IBICN=$$ICN^IBARXMU(DFN) I 'IBICN,'$D(IBTYPE) W !!,"No ICN for this patient" G AGAIN
"RTN","IBCNRDV",28,0)
I 'IBICN Q
"RTN","IBCNRDV",29,0)
;
"RTN","IBCNRDV",30,0)
; sent off the remote queries and get back handles
"RTN","IBCNRDV",31,0)
S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 D
"RTN","IBCNRDV",32,0)
. D SEND(.IBH,IBX,IBICN,$S($D(IBTYPE):"IBCN INSURANCE QUERY TASK",1:"IBCN INSURANCE QUERY"))
"RTN","IBCNRDV",33,0)
. X $S(IBH(0)'="":"S $P(IBT(IBX),U,5)=IBH(0)",1:"W:'$D(IBTYPE) !,""No handle returned for "",$P(IBT(IBX),U,2) K IBT(IBX)")
"RTN","IBCNRDV",34,0)
;
"RTN","IBCNRDV",35,0)
; no handles returned
"RTN","IBCNRDV",36,0)
I $D(IBT)<9,'$D(IBTYPE) W !!,"Unable to perform any remote queries.",! G AGAIN
"RTN","IBCNRDV",37,0)
I $D(IBT)<9 Q
"RTN","IBCNRDV",38,0)
;
"RTN","IBCNRDV",39,0)
;Create Duplicate Check Index
"RTN","IBCNRDV",40,0)
D INDEX(DFN)
"RTN","IBCNRDV",41,0)
;
"RTN","IBCNRDV",42,0)
; go through every IBT()
"RTN","IBCNRDV",43,0)
S IBP="|",IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1!($D(IBT)<9) D
"RTN","IBCNRDV",44,0)
. ;
"RTN","IBCNRDV",45,0)
. ; do I have a return data.
"RTN","IBCNRDV",46,0)
. F IBWAIT=1:1:60 W:'$D(IBTYPE) "." H 1 D CHECK(.IBR,$P(IBT(IBX),"^",5)) I $G(IBR(0))["Done" Q
"RTN","IBCNRDV",47,0)
. I $G(IBR(0))'["Done" W:'$D(IBTYPE) !!,"Unable to communicate with ",$P(IBT(IBX),U,2) Q
"RTN","IBCNRDV",48,0)
. K IBR
"RTN","IBCNRDV",49,0)
. D RETURN(.IBR,$P(IBT(IBX),"^",5))
"RTN","IBCNRDV",50,0)
. ;
"RTN","IBCNRDV",51,0)
. ; no data returned or error message
"RTN","IBCNRDV",52,0)
. S IBRZ=$S(-1=+$G(IBR):IBR,$G(IBR(0))="":$G(IBR(1)),1:$G(IBR(0)))
"RTN","IBCNRDV",53,0)
. ;
"RTN","IBCNRDV",54,0)
. ; no info to proceed
"RTN","IBCNRDV",55,0)
. I IBRZ<1 W:'$D(IBTYPE) !,"Response from ",$P(IBT(IBX),U,2),!,$P(IBRZ,"^",2) K IBT(IBX) D:IBRZ="-1^No insurance on file" FILE(0) Q
"RTN","IBCNRDV",56,0)
. ;
"RTN","IBCNRDV",57,0)
. ; received insurance info, need to file and display message
"RTN","IBCNRDV",58,0)
. W:'$D(IBTYPE) !,"Received ",$G(IBR(0))," insurance companies from ",$P(IBT(IBX),U,2) D FILE(+IBR(0))
"RTN","IBCNRDV",59,0)
. ;
"RTN","IBCNRDV",60,0)
. S IBY=0 F S IBY=$O(IBR(IBY)) Q:IBY<1 D
"RTN","IBCNRDV",61,0)
.. F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D
"RTN","IBCNRDV",62,0)
... ;
"RTN","IBCNRDV",63,0)
... ; am I on the right MAP line
"RTN","IBCNRDV",64,0)
... ;IB*2.0*631/TAZ - Insurance data comes in multiples of 7
"RTN","IBCNRDV",65,0)
... I $P(IBT,IBP,3)=$S(IBY#7:IBY#7,1:7) S IBZ=$P(IBR(IBY),"^",$P(IBT,IBP,4)) I $L(IBZ) D
"RTN","IBCNRDV",66,0)
.... ;
"RTN","IBCNRDV",67,0)
.... ; xecute code to change external to internal
"RTN","IBCNRDV",68,0)
.... X:$L($P(IBT,IBP,7)) $P(IBT,IBP,7)
"RTN","IBCNRDV",69,0)
.... ;
"RTN","IBCNRDV",70,0)
.... ; put the info in the array for the buffer file
"RTN","IBCNRDV",71,0)
.... S:$D(IBZ) IBB($P(IBT,IBP,5))=IBZ
"RTN","IBCNRDV",72,0)
.. ;
"RTN","IBCNRDV",73,0)
.. ; need to avoid duplicates if possible.
"RTN","IBCNRDV",74,0)
.. ;I $G(IBB(20.01))["MEDICARE (WNR)" S X=0 F S X=$O(^DPT(DFN,.312,X)) Q:X<1 I $P($G(^DIC(36,+$P($G(^DPT(DFN,.312,X,0)),"^"),0)),"^")["MEDICARE (WNR)" K IBB Q
"RTN","IBCNRDV",75,0)
.. ;
"RTN","IBCNRDV",76,0)
.. ; file in the buffer file & where else needed
"RTN","IBCNRDV",77,0)
.. ;IB*2.0*631/TAZ - File on the 7th multiple line (i.e. 7,14,21...)
"RTN","IBCNRDV",78,0)
.. I IBY#7=0 D
"RTN","IBCNRDV",79,0)
... I $L($G(IBB(20.01))) D
"RTN","IBCNRDV",80,0)
.... N IBOK S IBOK=1
"RTN","IBCNRDV",81,0)
.... S IBB(.14)=$$IEN^XUAF4(+IBT(IBX))
"RTN","IBCNRDV",82,0)
.... S IBB(.03)=$O(^IBE(355.12,"C","INSURANCE IMPORT",""))
"RTN","IBCNRDV",83,0)
.... D VCHECK(.IBB) I 'IBOK Q
"RTN","IBCNRDV",84,0)
.... S IBB=$$ADDSTF^IBCNBES($G(IBB(.03),1),DFN,.IBB)
"RTN","IBCNRDV",85,0)
... I '$D(IB1),$D(IBTYPE),$L($G(IBB(20.01))) D SCH^IBTUTL2(DFN,$G(IBSAVEI),$G(IBSAVEJ)):IBTYPE="TRKR",ADM^IBTUTL($G(IBSAVE1),$G(IBSAVE2),$G(IBSAVE3),$G(IBSAVE4)):IBTYPE="ADM" S IB1=1
"RTN","IBCNRDV",86,0)
... W:'$D(IBTYPE)&($L($G(IBB(20.01)))) !,$P($G(IBB),"^")," Buffer File entry for ",$G(IBB(20.01))
"RTN","IBCNRDV",87,0)
... K IBB
"RTN","IBCNRDV",88,0)
;
"RTN","IBCNRDV",89,0)
; flag so I don't do this patient again within 90 days
"RTN","IBCNRDV",90,0)
S ^IBT(356,"ARDV",DFN,$$FMADD^XLFDT(DT,90))=""
"RTN","IBCNRDV",91,0)
;
"RTN","IBCNRDV",92,0)
; Clean up ^TMP global
"RTN","IBCNRDV",93,0)
K ^TMP("IBCNRDV",$J)
"RTN","IBCNRDV",94,0)
;
"RTN","IBCNRDV",95,0)
Q
"RTN","IBCNRDV",96,0)
;
"RTN","IBCNRDV",97,0)
VCHECK(IBB) ; Check to make sure the record is not duplicate and passes validity check.
"RTN","IBCNRDV",98,0)
;
"RTN","IBCNRDV",99,0)
;Check for duplicates
"RTN","IBCNRDV",100,0)
I $$DUP(.IBB) S IBOK=0 G VCHECKX
"RTN","IBCNRDV",101,0)
; Validate entries to insure we are only getting the data we want.
"RTN","IBCNRDV",102,0)
I '$$VALID(.IBB) S IBOK=0 G VCHECKX
"RTN","IBCNRDV",103,0)
;Add to index
"RTN","IBCNRDV",104,0)
N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
"RTN","IBCNRDV",105,0)
S IBINSNM=$G(IBB(20.01)) I IBINSNM']"" S IBINSNM=" "
"RTN","IBCNRDV",106,0)
S IBGRP=$G(IBB(40.03)) I IBGRP']"" S IBGRP=" "
"RTN","IBCNRDV",107,0)
S IBSUBID=$G(IBB(60.04)) I IBSUBID']"" S IBSUBID=" "
"RTN","IBCNRDV",108,0)
S IBNAME=$P($G(IBB(60.07))," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
"RTN","IBCNRDV",109,0)
S IBDOB=$G(IBB(60.08)) I 'IBDOB S IBDOB=" "
"RTN","IBCNRDV",110,0)
S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
"RTN","IBCNRDV",111,0)
;
"RTN","IBCNRDV",112,0)
VCHECKX ;
"RTN","IBCNRDV",113,0)
Q
"RTN","IBCNRDV",114,0)
;
"RTN","IBCNRDV",115,0)
INDEX(DFN) ;
"RTN","IBCNRDV",116,0)
K ^TMP("IBCNRDV",$J)
"RTN","IBCNRDV",117,0)
N IBBUFDA,IBIEN
"RTN","IBCNRDV",118,0)
; From Buffer
"RTN","IBCNRDV",119,0)
S IBBUFDA=0
"RTN","IBCNRDV",120,0)
F S IBBUFDA=$O(^IBA(355.33,"C",DFN,IBBUFDA)) Q:'IBBUFDA D
"RTN","IBCNRDV",121,0)
. N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
"RTN","IBCNRDV",122,0)
. S IBINSNM=$$GET1^DIQ(355.33,IBBUFDA_",","INSURANCE COMPANY NAME") I IBINSNM']"" S IBINSNM=" "
"RTN","IBCNRDV",123,0)
. S IBGRP=$$GET1^DIQ(355.33,IBBUFDA_",","GROUP NUMBER") I IBGRP']"" S IBGRP=" "
"RTN","IBCNRDV",124,0)
. S IBSUBID=$$GET1^DIQ(355.33,IBBUFDA_",","SUBSCRIBER ID") I IBSUBID']"" S IBSUBID=" "
"RTN","IBCNRDV",125,0)
. S IBNAME=$P($$GET1^DIQ(355.33,IBBUFDA_",","NAME OF INSURED")," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
"RTN","IBCNRDV",126,0)
. S IBDOB=$$GET1^DIQ(355.33,IBBUFDA_",","INSURED'S DOB","I") I 'IBDOB S IBDOB=" "
"RTN","IBCNRDV",127,0)
. S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
"RTN","IBCNRDV",128,0)
; From active Insurance
"RTN","IBCNRDV",129,0)
K IBINS
"RTN","IBCNRDV",130,0)
D ALL^IBCNS1(DFN,"IBINS",2) ; Get all active insurance
"RTN","IBCNRDV",131,0)
I $G(IBINS(0)) S IBIEN=0 F S IBIEN=$O(IBINS(IBIEN)) Q:'IBIEN D
"RTN","IBCNRDV",132,0)
. N IBDOB,IBGRP,IBINSIEN,IBINSNM,IBNAME,IBSUBID
"RTN","IBCNRDV",133,0)
. S IBINSIEN=+$P($G(IBINS(IBIEN,0)),U,1)
"RTN","IBCNRDV",134,0)
. S IBINSNM=$$GET1^DIQ(36,IBINSIEN_",","NAME") I IBINSNM']"" S IBINSNM=" "
"RTN","IBCNRDV",135,0)
. S IBGRP=$P($G(IBINS(IBIEN,355.3)),U,4) I IBGRP']"" S IBGRP=" "
"RTN","IBCNRDV",136,0)
. S IBSUBID=$P($G(IBINS(IBIEN,7)),U,2) I IBSUBID']"" S IBSUBID=" "
"RTN","IBCNRDV",137,0)
. S IBNAME=$P($P($G(IBINS(IBIEN,7)),U)," ") I IBNAME']"" S IBNAME=" "
"RTN","IBCNRDV",138,0)
. S IBDOB=$P($G(IBINS(IBIEN,3)),U) I 'IBDOB S IBDOB=" "
"RTN","IBCNRDV",139,0)
. S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
"RTN","IBCNRDV",140,0)
K IBINS
"RTN","IBCNRDV",141,0)
;
"RTN","IBCNRDV",142,0)
Q
"RTN","IBCNRDV",143,0)
;
"RTN","IBCNRDV",144,0)
RPC(IBD,IBICN) ; RPC entry for looking up insurance info
"RTN","IBCNRDV",145,0)
N DFN,IBZ,IBX,IBY,IBP,IBI,IBT,IBZ
"RTN","IBCNRDV",146,0)
S DFN=$$DFN^IBARXMU(IBICN) I 'DFN S IBD(0)="-1^ICN Not found" Q
"RTN","IBCNRDV",147,0)
D ALL^IBCNS1(DFN,"IBY",3)
"RTN","IBCNRDV",148,0)
I '$D(IBY) S IBD(0)="-1^No insurance on file" Q
"RTN","IBCNRDV",149,0)
; set up return format
"RTN","IBCNRDV",150,0)
; IBD(0) = # of insurance companies
"RTN","IBCNRDV",151,0)
S IBD(0)=$G(IBY(0))
"RTN","IBCNRDV",152,0)
;
"RTN","IBCNRDV",153,0)
; where n starts at 1 and increments to 7 for each insurance company
"RTN","IBCNRDV",154,0)
; IBD(n) = 355.33, zero node format
"RTN","IBCNRDV",155,0)
; IBD(n+1) = 355.33, 20 node format
"RTN","IBCNRDV",156,0)
; IBD(n+2) = 355.33, 21 node format
"RTN","IBCNRDV",157,0)
; IBD(n+3) = 355.33, 40 node format
"RTN","IBCNRDV",158,0)
; IBD(n+4) = 355.33, 60 node format
"RTN","IBCNRDV",159,0)
; IBD(n+5) = 355.33, 61 node format
"RTN","IBCNRDV",160,0)
; IBD(n+6) = 355.33, 62 node format
"RTN","IBCNRDV",161,0)
;
"RTN","IBCNRDV",162,0)
S IBP="|"
"RTN","IBCNRDV",163,0)
S IBI=0 F S IBI=$O(IBY(IBI)) Q:IBI<1 F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D
"RTN","IBCNRDV",164,0)
. S IBZ=$P($G(IBY(IBI,+IBT)),"^",$P(IBT,IBP,2)) ; set the existing data
"RTN","IBCNRDV",165,0)
. I $L($P(IBT,IBP,6)) X $P(IBT,IBP,6) ; output transform
"RTN","IBCNRDV",166,0)
. S $P(IBD(IBI-1*7+$P(IBT,IBP,3)),"^",$P(IBT,IBP,4))=IBZ ; set data IBD
"RTN","IBCNRDV",167,0)
Q
"RTN","IBCNRDV",168,0)
;
"RTN","IBCNRDV",169,0)
MAP ; this is a mapping of data returned from ALL^IBCNS1 to the buffer file
"RTN","IBCNRDV",170,0)
; format is: node number | piece | extract node | extract piece
"RTN","IBCNRDV",171,0)
; | 355.33 field number | format out code (if any)
"RTN","IBCNRDV",172,0)
; | format in code (if any)
"RTN","IBCNRDV",173,0)
; the extract nodes will be sequential to match buffer file DD
"RTN","IBCNRDV",174,0)
;;0|1|2|1|20.01|N Z X "F Z=0,.11,.13 S IBY(IBI,36+Z)=$G(^DIC(36,IBZ,Z))" S IBZ=$P(IBY(IBI,36),"^");ins co name
"RTN","IBCNRDV",175,0)
;;0|2|5|4|60.04;subscriber id
"RTN","IBCNRDV",176,0)
;;0|4|5|3|60.03;experation date
"RTN","IBCNRDV",177,0)
;;0|6|5|5|60.05;who's insurance
"RTN","IBCNRDV",178,0)
;;0|8|5|2|60.02;effective date
"RTN","IBCNRDV",179,0)
;;0|16|5|6|60.06;pt relationship to insured
"RTN","IBCNRDV",180,0)
;;0|17|5|7|60.07;name of insured
"RTN","IBCNRDV",181,0)
;;0|20|5|12|60.12;coordination of benefits
"RTN","IBCNRDV",182,0)
;;1|1|1|1|.01||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date entered ;IB*593/TAZ
"RTN","IBCNRDV",183,0)
;;1|3|1|10|.1||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date (last) verified
"RTN","IBCNRDV",184,0)
;;1|9|1|3|.03||S IBZ=$O(^IBE(355.12,"C","INSURANCE IMPORT",""));source of information ; Patch #593 Set to INSPT
"RTN","IBCNRDV",185,0)
;;2|1|6|5|61.05;send bill to employer
"RTN","IBCNRDV",186,0)
;;2|2|6|6|61.06;employer claims street address (line 1)
"RTN","IBCNRDV",187,0)
;;2|3|6|7|61.07;employer claims street address line 2
"RTN","IBCNRDV",188,0)
;;2|4|6|8|61.08;employer claims street address line 3
"RTN","IBCNRDV",189,0)
;;2|5|6|9|61.09;employer claims city
"RTN","IBCNRDV",190,0)
;;2|6|6|10|61.1|S IBZ=$$EXTERNAL^DILFD(2.312,2.06,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;employer claims state
"RTN","IBCNRDV",191,0)
;;2|7|6|11|61.11;employer claims zip code
"RTN","IBCNRDV",192,0)
;;2|8|6|12|61.12;employer claims phone
"RTN","IBCNRDV",193,0)
;;2|10|6|1|61.01;esghp
"RTN","IBCNRDV",194,0)
;;2|11|6|3|61.03;employment status
"RTN","IBCNRDV",195,0)
;;2|12|6|4|61.04;retirement date
"RTN","IBCNRDV",196,0)
;;3|1|5|8|60.08;insured's dob
"RTN","IBCNRDV",197,0)
;;3|5|5|9|60.09;insured's ssn
"RTN","IBCNRDV",198,0)
;;3|12|5|13|60.13;insured's sex
"RTN","IBCNRDV",199,0)
;;4|1|5|10|60.1;primary care provider
"RTN","IBCNRDV",200,0)
;;4|2|5|11|60.11;primary provider phone
"RTN","IBCNRDV",201,0)
;;4|5|5|15|60.15;pharmacy relationship code
"RTN","IBCNRDV",202,0)
;;4|6|5|16|60.16;pharmacy person code
"RTN","IBCNRDV",203,0)
;;5|1|7|1|62.01;patient id
"RTN","IBCNRDV",204,0)
;;355.3|2|4|1|40.01;is this a group policy
"RTN","IBCNRDV",205,0)
;;355.3|3|4|2|40.02;group name
"RTN","IBCNRDV",206,0)
;;355.3|4|4|3|40.03;group number
"RTN","IBCNRDV",207,0)
;;355.3|5|4|4|40.04;(is) utilization required
"RTN","IBCNRDV",208,0)
;;355.3|6|4|5|40.05;(is) pre-certification required
"RTN","IBCNRDV",209,0)
;;355.3|7|4|7|40.07;exclude pre-existing condition
"RTN","IBCNRDV",210,0)
;;355.3|8|4|8|40.08;benefits assignable
"RTN","IBCNRDV",211,0)
;;355.3|9|4|9|40.09;type of plan
"RTN","IBCNRDV",212,0)
;;355.3|12|4|6|40.06;ambulatory care certification
"RTN","IBCNRDV",213,0)
;;36|2|2|5|20.05;reimburse
"RTN","IBCNRDV",214,0)
;;36.11|1|3|1|21.01;street address line 1
"RTN","IBCNRDV",215,0)
;;36.11|2|3|2|21.02;street address line 2
"RTN","IBCNRDV",216,0)
;;36.11|3|3|3|21.03;street address line 3
"RTN","IBCNRDV",217,0)
;;36.11|4|3|4|21.04;city
"RTN","IBCNRDV",218,0)
;;36.11|5|3|5|21.05|S IBZ=$$EXTERNAL^DILFD(36,.115,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;state
"RTN","IBCNRDV",219,0)
;;36.11|6|3|6|21.06;zip code
"RTN","IBCNRDV",220,0)
;;36.13|1|2|2|20.02;phone number
"RTN","IBCNRDV",221,0)
;;36.13|2|2|3|20.03;billing phone number
"RTN","IBCNRDV",222,0)
;;36.13|3|2|4|20.04;precertification phone number
"RTN","IBCNRDV",223,0)
;;
"RTN","IBCNRDV",224,0)
;
"RTN","IBCNRDV",225,0)
SEND(IBH,IBX,IBICN,IBRPC) ; called to send off queries
"RTN","IBCNRDV",226,0)
D EN1^XWB2HL7(.IBH,IBX,IBRPC,"",IBICN)
"RTN","IBCNRDV",227,0)
Q
"RTN","IBCNRDV",228,0)
;
"RTN","IBCNRDV",229,0)
CHECK(IBR,IBH) ; called to check the return status of an RPC
"RTN","IBCNRDV",230,0)
D RPCCHK^XWB2HL7(.IBR,IBH)
"RTN","IBCNRDV",231,0)
Q
"RTN","IBCNRDV",232,0)
;
"RTN","IBCNRDV",233,0)
RETURN(IBR,IBH) ; called to get the return data and clear the broker
"RTN","IBCNRDV",234,0)
N IBZ
"RTN","IBCNRDV",235,0)
D RTNDATA^XWBDRPC(.IBR,IBH),CLEAR^XWBDRPC(.IBZ,IBH)
"RTN","IBCNRDV",236,0)
Q
"RTN","IBCNRDV",237,0)
;
"RTN","IBCNRDV",238,0)
TASK ; queue off task job
"RTN","IBCNRDV",239,0)
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
"RTN","IBCNRDV",240,0)
S ZTRTN="BACKGND^IBCNRDV",ZTDESC="Query Remote Facilities for Insurance",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT),(ZTIO,ZTSAVE("DFN"),ZTSAVE("IBSAVE*"),ZTSAVE("IBTYPE"))="" D ^%ZTLOAD
"RTN","IBCNRDV",241,0)
Q
"RTN","IBCNRDV",242,0)
;
"RTN","IBCNRDV",243,0)
TRKR(DFN,IBSAVEI,IBSAVEJ,IBDUZ) ; claims tracking entry
"RTN","IBCNRDV",244,0)
N IBTYPE,IBT
"RTN","IBCNRDV",245,0)
Q:$D(^IBT(356,"ARDV",DFN)) ; have already done recently
"RTN","IBCNRDV",246,0)
Q:'$$TFL^IBARXMU(DFN,.IBT) ; no remote facilities
"RTN","IBCNRDV",247,0)
S IBTYPE="TRKR" D
"RTN","IBCNRDV",248,0)
. I DUZ=.5 N DUZ S DUZ=+$G(IBDUZ),DUZ(2)=+$$SITE^VASITE
"RTN","IBCNRDV",249,0)
. D TASK
"RTN","IBCNRDV",250,0)
Q
"RTN","IBCNRDV",251,0)
;
"RTN","IBCNRDV",252,0)
ADM(DFN,IBSAVE1,IBSAVE2,IBSAVE3,IBSAVE4) ; admit event entry
"RTN","IBCNRDV",253,0)
N IBTYPE S IBTYPE="ADM" D TASK
"RTN","IBCNRDV",254,0)
Q
"RTN","IBCNRDV",255,0)
;
"RTN","IBCNRDV",256,0)
FILE(IBX) ; updates data into the log file
"RTN","IBCNRDV",257,0)
;IBX = number of insurance co's found
"RTN","IBCNRDV",258,0)
N DIC,DA,DIE,IBM,DO,X,Y,IBZ,DR
"RTN","IBCNRDV",259,0)
S IBM=$E($$DT^XLFDT,1,5)_"00",DA=+$O(^IBA(355.34,"B",IBM,0))
"RTN","IBCNRDV",260,0)
I 'DA K DA L +^IBA(355.34,"B",IBM):10 S X=IBM,DIC="^IBA(355.34,",DIC(0)="F" D FILE^DICN S DA=+Y L -^IBA(355.34,"B",IBM)
"RTN","IBCNRDV",261,0)
L +^IBA(355.34,DA):10
"RTN","IBCNRDV",262,0)
S IBZ=^IBA(355.34,DA,0),DIE="^IBA(355.34,"
"RTN","IBCNRDV",263,0)
S DR=".02///"_($P(IBZ,"^",2)+1)_";.03///"_($P(IBZ,"^",3)+IBX) D ^DIE
"RTN","IBCNRDV",264,0)
L -^IBA(355.34,DA)
"RTN","IBCNRDV",265,0)
Q
"RTN","IBCNRDV",266,0)
;
"RTN","IBCNRDV",267,0)
VALID(IBARY) ; Check for invalid entries in the incoming data
"RTN","IBCNRDV",268,0)
;Screen for Active Policy
"RTN","IBCNRDV",269,0)
;Screen for EXPIRATION DATE - Don't file expired policies
"RTN","IBCNRDV",270,0)
N DATA,EXCLUDE,IBEFFDT,IBEXPDT,IBTOP,LN,TAG,VALID
"RTN","IBCNRDV",271,0)
S VALID=1
"RTN","IBCNRDV",272,0)
; Check for expired policy
"RTN","IBCNRDV",273,0)
S IBEXPDT=$G(IBARY(60.03))
"RTN","IBCNRDV",274,0)
I IBEXPDT'="",($$FMDIFF^XLFDT(DT,IBEXPDT,1)>0) S VALID=0 G VALIDQ
"RTN","IBCNRDV",275,0)
I IBEXPDT="" D I 'VALID G VALIDQ
"RTN","IBCNRDV",276,0)
. ;Use LAST VERIFIED
"RTN","IBCNRDV",277,0)
. I $G(IBARY(.1)) D Q
"RTN","IBCNRDV",278,0)
.. I $$FMDIFF^XLFDT(DT,IBARY(.1),1)>730 S VALID=0 ;POLICY GREATER THAN 2 YEARS OLD.
"RTN","IBCNRDV",279,0)
. ;Use Date Entered
"RTN","IBCNRDV",280,0)
. I $G(IBARY(.01)),$$FMDIFF^XLFDT(DT,$G(IBARY(.01)),1)>730 S VALID=0 ;POLICY GREATER THAN 2 YEARS OLD.
"RTN","IBCNRDV",281,0)
;
"RTN","IBCNRDV",282,0)
;Screen EFFECTIVE DATE - Cannot be blank or future
"RTN","IBCNRDV",283,0)
S IBEFFDT=$G(IBARY(60.02))
"RTN","IBCNRDV",284,0)
I IBEFFDT="" S VALID=0 G VALIDQ ;BLANK EFFECTIVE DATE IS INVALID
"RTN","IBCNRDV",285,0)
I IBEFFDT'="",($$FMDIFF^XLFDT(DT,IBEFFDT,1)<0) S VALID=0 G VALIDQ ;FUTURE EFFECTIVE DATE IS INVALID
"RTN","IBCNRDV",286,0)
;
"RTN","IBCNRDV",287,0)
;Screen Type of Plan
"RTN","IBCNRDV",288,0)
S EXCLUDE="^"
"RTN","IBCNRDV",289,0)
F LN=2:1 S TAG="EXCTOP+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" S EXCLUDE=EXCLUDE_$$FIND1^DIC(355.1,"","X",DATA)_"^"
"RTN","IBCNRDV",290,0)
S IBTOP=$G(IBARY(40.09))
"RTN","IBCNRDV",291,0)
I IBTOP'="",$F(EXCLUDE,(U_IBTOP_U)) S VALID=0 G VALIDQ
"RTN","IBCNRDV",292,0)
;
"RTN","IBCNRDV",293,0)
; Re-Initialize variables for filing.
"RTN","IBCNRDV",294,0)
S IBARY(.01)=DT ;Set DATE ENTERED = today's date
"RTN","IBCNRDV",295,0)
S IBARY(.02)="" ;Set ENTERED BY = NULL
"RTN","IBCNRDV",296,0)
S IBARY(.1)="" ;Set DATE VERIFIED = NULL
"RTN","IBCNRDV",297,0)
S IBARY(.11)="" ;Set VERIFIED BY = NULL
"RTN","IBCNRDV",298,0)
;
"RTN","IBCNRDV",299,0)
VALIDQ ;
"RTN","IBCNRDV",300,0)
I 'VALID K IBARY
"RTN","IBCNRDV",301,0)
Q VALID
"RTN","IBCNRDV",302,0)
;
"RTN","IBCNRDV",303,0)
DUP(IBARY) ; Check for duplicate in the incoming data
"RTN","IBCNRDV",304,0)
N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
"RTN","IBCNRDV",305,0)
S IBINSNM=$G(IBARY(20.01)) I IBINSNM']"" S IBINSNM=" "
"RTN","IBCNRDV",306,0)
S IBGRP=$G(IBARY(40.03)) I IBGRP']"" S IBGRP=" "
"RTN","IBCNRDV",307,0)
S IBSUBID=$G(IBARY(60.04)) I IBSUBID']"" S IBSUBID=" "
"RTN","IBCNRDV",308,0)
S IBNAME=$P($G(IBARY(60.07))," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
"RTN","IBCNRDV",309,0)
S IBDOB=$G(IBARY(60.08)) I 'IBDOB S IBDOB=" "
"RTN","IBCNRDV",310,0)
Q $D(^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB))
"RTN","IBCNRDV",311,0)
;
"RTN","IBCNRDV",312,0)
EXCTOP ;Plan Types to Exclude
"RTN","IBCNRDV",313,0)
;
"RTN","IBCNRDV",314,0)
;;ACCIDENT AND HEALTH INSURANCE
"RTN","IBCNRDV",315,0)
;;AUTOMOBILE
"RTN","IBCNRDV",316,0)
;;AVIATION TRIP INSURANCE
"RTN","IBCNRDV",317,0)
;;CATASTROPHIC INSURANCE
"RTN","IBCNRDV",318,0)
;;COINSURANCE
"RTN","IBCNRDV",319,0)
;;DUAL COVERAGE
"RTN","IBCNRDV",320,0)
;;HOSPITAL-MEDICAL INSURANCE
"RTN","IBCNRDV",321,0)
;;INCOME PROTECTION (INDEMNITY)
"RTN","IBCNRDV",322,0)
;;KEY-MAN HEALTH INSURANCE
"RTN","IBCNRDV",323,0)
;;MAJOR MEDICAL EXPENSE INSURANCE
"RTN","IBCNRDV",324,0)
;;MEDI-CAL
"RTN","IBCNRDV",325,0)
;;MEDICAID
"RTN","IBCNRDV",326,0)
;;MEDICARE/MEDICAID (MEDI-CAL)
"RTN","IBCNRDV",327,0)
;;NO-FAULT INSURANCE
"RTN","IBCNRDV",328,0)
;;QUALIFIED IMPAIRMENT INSURANCE
"RTN","IBCNRDV",329,0)
;;SPECIAL CLASS INSURANCE
"RTN","IBCNRDV",330,0)
;;SPECIAL RISK INSURANCE
"RTN","IBCNRDV",331,0)
;;SPECIFIED DISEASE INSURANCE
"RTN","IBCNRDV",332,0)
;;TORT FEASOR
"RTN","IBCNRDV",333,0)
;;WORKERS' COMPENSATION INSURANCE
"RTN","IBCNRDV",334,0)
;
"RTN","IBCNSJ51")
0^2^B64267141^B28017829
"RTN","IBCNSJ51",1,0)
IBCNSJ51 ;ALB/TMP - INSURANCE PLAN MAINTENANCE ACTION PROCESSING (continued); 15-AUG-95
"RTN","IBCNSJ51",2,0)
;;2.0;INTEGRATED BILLING;**43,631**;21-MAR-94;Build 11
"RTN","IBCNSJ51",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNSJ51",4,0)
;
"RTN","IBCNSJ51",5,0)
EDCOV ; Add/edit limitations of coverage for a plan in IBCPOL
"RTN","IBCNSJ51",6,0)
;/IB*2.0*631/vd - Added the variables IBALL and OPTN (for US4555)
"RTN","IBCNSJ51",7,0)
N DIC,DIE,DR,DONE,DONE1,IB1,IBALL,IBCOV,IBCNT,IBEDT,IBOK,IBOUT,IBQUIT,IBTYP,OPTN,Z
"RTN","IBCNSJ51",8,0)
G:'$G(IBCPOL) EDCOVEX
"RTN","IBCNSJ51",9,0)
D FULL^VALM1
"RTN","IBCNSJ51",10,0)
;
"RTN","IBCNSJ51",11,0)
S (DONE,OPTN)=0
"RTN","IBCNSJ51",12,0)
S DONE=0
"RTN","IBCNSJ51",13,0)
F D Q:DONE!(OPTN<0) ; Effective date selection
"RTN","IBCNSJ51",14,0)
.K DIR
"RTN","IBCNSJ51",15,0)
.W !
"RTN","IBCNSJ51",16,0)
.S DIR(0)="DO",DIR("A")="Select EFFECTIVE DATE",DIR("?")="^D COVDTH^IBCNSJ51" S:$D(IBEDT) DIR("B")=$$DAT1^IBOUTL(IBEDT)
"RTN","IBCNSJ51",17,0)
.D ^DIR W:$D(Y(0)) " ",Y(0) K DIR
"RTN","IBCNSJ51",18,0)
.I $D(DIRUT) S DONE=1 Q
"RTN","IBCNSJ51",19,0)
.S IBEDT=Y\1,IBCNT=0
"RTN","IBCNSJ51",20,0)
.K IBTYP
"RTN","IBCNSJ51",21,0)
.;
"RTN","IBCNSJ51",22,0)
.S DONE1=0
"RTN","IBCNSJ51",23,0)
.F D Q:DONE1!(OPTN<0) ; Coverage category type selection
"RTN","IBCNSJ51",24,0)
..K DIR
"RTN","IBCNSJ51",25,0)
..W !
"RTN","IBCNSJ51",26,0)
..S DIR(0)="F"_$S(IBCNT:"O",1:"")_"^1:30",DIR("A")="Select "_$S(IBCNT:"another ",1:"")_"coverage category -OR- "_$S(IBCNT:"Press ENTER if selection is complete",1:"'ALL' to select all coverage categories")
"RTN","IBCNSJ51",27,0)
..S DIR("?")="^D COVTYPH^IBCNSJ51"
"RTN","IBCNSJ51",28,0)
..D ^DIR K DIR
"RTN","IBCNSJ51",29,0)
..I $D(DUOUT)!$D(DTOUT) S DONE1=1 Q
"RTN","IBCNSJ51",30,0)
..;
"RTN","IBCNSJ51",31,0)
..S IBALL=Y ;/IB*2.0*631 - vd - Preserving the 'Y' variable in the IBALL variable so it won't get stepped on.
"RTN","IBCNSJ51",32,0)
..;/IB*2.0*631 - vd - Added some new prompting and deleting capabilities below, for US4555.
"RTN","IBCNSJ51",33,0)
..I IBALL="ALL" D
"RTN","IBCNSJ51",34,0)
...S OPTN="E",IBTYP=0 ; Default OPTN to EDIT...if no categories exist for date...we just want to ADD. No need to ask 'Edit or Delete' question.
"RTN","IBCNSJ51",35,0)
...F S IBTYP=$O(^IBE(355.31,IBTYP)) Q:'IBTYP D Q:(OPTN="")
"RTN","IBCNSJ51",36,0)
....I $D(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT)) S OPTN="" ; Found a category with this date...so able to ask 'Edit or Delete' question.
"RTN","IBCNSJ51",37,0)
...I OPTN="" S OPTN=$$ASK(0) Q:(OPTN<0)
"RTN","IBCNSJ51",38,0)
..I IBALL'="" D Q:$TR(IBCNT,"al","AL")'="ALL"
"RTN","IBCNSJ51",39,0)
...I 'IBCNT,IBALL="ALL" D Q
"RTN","IBCNSJ51",40,0)
....S IBCNT="ALL",IBTYP=0
"RTN","IBCNSJ51",41,0)
....F S IBTYP=$O(^IBE(355.31,IBTYP)) Q:'IBTYP D
"RTN","IBCNSJ51",42,0)
.....I OPTN="D" D Q
"RTN","IBCNSJ51",43,0)
......I $D(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT)) S IBTYP(IBTYP)=""
"RTN","IBCNSJ51",44,0)
.....I $$WARN1(IBTYP) S IBTYP(IBTYP)=""
"RTN","IBCNSJ51",45,0)
...S DIC="^IBE(355.31,",DIC(0)="EMQ",X=IBALL D ^DIC
"RTN","IBCNSJ51",46,0)
...I Y<0 Q:'$$QUIT() S (DONE,DONE1)=1,IBCNT="" K IBTYP Q
"RTN","IBCNSJ51",47,0)
...I $D(IBTYP(+Y)) W !,"This category already selected." Q
"RTN","IBCNSJ51",48,0)
...S IBTYP=+Y I $$WARN1(IBTYP) S IBTYP(IBTYP)="",IBCNT=IBCNT+1
"RTN","IBCNSJ51",49,0)
..;
"RTN","IBCNSJ51",50,0)
..I $O(IBTYP(""))="" S (DONE,DONE1)=1 Q
"RTN","IBCNSJ51",51,0)
..;
"RTN","IBCNSJ51",52,0)
..I IBALL="ALL",OPTN="D" D DELETE(IBALL,IBEDT) Q
"RTN","IBCNSJ51",53,0)
..;
"RTN","IBCNSJ51",54,0)
..S IBTYP=""
"RTN","IBCNSJ51",55,0)
..F S IBTYP=$O(IBTYP(IBTYP)) Q:IBTYP="" D Q:DONE1!(OPTN<0)
"RTN","IBCNSJ51",56,0)
...K ^TMP($J,"IBCAT")
"RTN","IBCNSJ51",57,0)
...W !!,"Effective Date: ",$$DAT1^IBOUTL(IBEDT)," Coverage Category: ",$P($G(^IBE(355.31,+IBTYP,0)),U)
"RTN","IBCNSJ51",58,0)
...S OPTN="",DA=$O(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT,""))
"RTN","IBCNSJ51",59,0)
...;/IB*2.0*631 - vd - Added some new prompting and deleting capabilities below, for US4555.
"RTN","IBCNSJ51",60,0)
...I 'DA S OPTN="E"
"RTN","IBCNSJ51",61,0)
...I IBALL'="ALL",OPTN="" S OPTN=$$ASK(1) Q:(OPTN<0) I OPTN="D" D Q
"RTN","IBCNSJ51",62,0)
....D DELETE(IBALL,IBEDT,DA)
"RTN","IBCNSJ51",63,0)
...I DA'="" D SAVE^IBCNSJ52(DA) W !,"Editing existing record.",!
"RTN","IBCNSJ51",64,0)
...I DA="" D Q:'DA ;Add a new record
"RTN","IBCNSJ51",65,0)
....W ! S DIR(0)="Y",DIR("A",1)="A new record will be added for this EFFECTIVE DATE/coverage category."
"RTN","IBCNSJ51",66,0)
....S DIR("A")="Is this OK",DIR("B")="YES" D ^DIR K DIR
"RTN","IBCNSJ51",67,0)
....I Y'=1 S:$$QUIT() (DONE,DONE1)=1 Q
"RTN","IBCNSJ51",68,0)
....K DO,DD
"RTN","IBCNSJ51",69,0)
....S DIC="^IBA(355.32,",DIC(0)="L",X=IBCPOL,DIC("DR")=".02////"_IBTYP_";.03////"_IBEDT_";.04////1" D FILE^DICN
"RTN","IBCNSJ51",70,0)
....S DA=$S(Y>0:+Y,1:0)
"RTN","IBCNSJ51",71,0)
....W:DA !,"New record added.",!
"RTN","IBCNSJ51",72,0)
...;
"RTN","IBCNSJ51",73,0)
...S IBCOV=DA
"RTN","IBCNSJ51",74,0)
...;
"RTN","IBCNSJ51",75,0)
...L +^IBA(355.32,IBCOV):5 I '$T D LOCKED^IBTRCD1 Q
"RTN","IBCNSJ51",76,0)
...S DIE="^IBA(355.32,",DR=".04;S Y=$S(X'>1:"""",1:2);2"
"RTN","IBCNSJ51",77,0)
...D ^DIE S IBOUT=$D(Y)
"RTN","IBCNSJ51",78,0)
...I $P($G(^IBA(355.32,IBCOV,0)),U,4)'>1,$O(^(2,0)) S Z=0 F S Z=$O(^IBA(355.32,IBCOV,2,Z)) Q:'Z S DIK="^IBA(355.32,"_IBCOV_",2,",DA(1)=IBCOV,DA=Z D ^DIK ;Delete comments
"RTN","IBCNSJ51",79,0)
...I $$DIFFLIM^IBCNSJ52(IBCOV) S DIE="^IBA(355.32,",DA=IBCOV,DR="1.03///NOW;1.04////^S X=DUZ" D ^DIE ;Update user who edited entry
"RTN","IBCNSJ51",80,0)
...L -^IBA(355.32,IBCOV)
"RTN","IBCNSJ51",81,0)
...;
"RTN","IBCNSJ51",82,0)
...I IBOUT,$$QUIT() S (DONE,DONE1)=1
"RTN","IBCNSJ51",83,0)
..K IBTYP S IBCNT=0
"RTN","IBCNSJ51",84,0)
;
"RTN","IBCNSJ51",85,0)
EDCOVEX S VALMBCK="R"
"RTN","IBCNSJ51",86,0)
K ^TMP($J,"IBCOV")
"RTN","IBCNSJ51",87,0)
Q
"RTN","IBCNSJ51",88,0)
;
"RTN","IBCNSJ51",89,0)
QUIT() ; Quit coverage limitation loop
"RTN","IBCNSJ51",90,0)
N DIR,Y
"RTN","IBCNSJ51",91,0)
S DIR(0)="Y",DIR("A")="Do you want to exit this function now",DIR("B")="YES" D ^DIR
"RTN","IBCNSJ51",92,0)
Q Y
"RTN","IBCNSJ51",93,0)
;
"RTN","IBCNSJ51",94,0)
COVDTH ; Help text for selecting effective date on coverage add/edit
"RTN","IBCNSJ51",95,0)
N Z,Z0,ZX,CT
"RTN","IBCNSJ51",96,0)
D HELP^%DTC
"RTN","IBCNSJ51",97,0)
I $O(^IBA(355.32,"APCD",IBCPOL,""))="" W !!,"No current dates on file for this plan." Q
"RTN","IBCNSJ51",98,0)
W !!,"Current dates on file for this plan:"
"RTN","IBCNSJ51",99,0)
S Z="" F S Z=$O(^IBA(355.32,"APCD",IBCPOL,Z)) Q:'Z S Z0="" F S Z0=$O(^IBA(355.32,"APCD",IBCPOL,Z,Z0)) Q:'Z0 S ZX(Z0,Z)=""
"RTN","IBCNSJ51",100,0)
S Z="" F S Z=$O(ZX(Z)) Q:'Z W !,?3,$$DAT1^IBOUTL(-Z)," -" S Z0="",CT=0 F S Z0=$O(ZX(Z,Z0)) Q:'Z0!(CT>3) S CT=CT+1 W " ",$P($G(^IBE(355.31,Z0,0)),U) W:CT=4&($O(ZX(Z,Z0))'="") " (and more)"
"RTN","IBCNSJ51",101,0)
Q
"RTN","IBCNSJ51",102,0)
;
"RTN","IBCNSJ51",103,0)
COVTYPH ; Help text for selecting coverage category on coverage add/edit
"RTN","IBCNSJ51",104,0)
N DIC
"RTN","IBCNSJ51",105,0)
W !!,"Enter a coverage category to add/edit coverage limitations for.",!
"RTN","IBCNSJ51",106,0)
S DIC="^IBE(355.31,",DIC(0)="M",X="?" D ^DIC
"RTN","IBCNSJ51",107,0)
I '$G(IBCNT) W !,"Enter ALL to select all coverage categories."
"RTN","IBCNSJ51",108,0)
W !,"You may enter multiple coverage categories by entering them one at a time.",!,"After you have selected all needed categories, press ENTER at this prompt to",!,"continue."
"RTN","IBCNSJ51",109,0)
Q
"RTN","IBCNSJ51",110,0)
;
"RTN","IBCNSJ51",111,0)
WARN1(IBTYP) ; Warning if adding/editing an earlier effective date than latest one on file
"RTN","IBCNSJ51",112,0)
N IB1,Y
"RTN","IBCNSJ51",113,0)
S IB1=$O(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-9999999)),Y=1
"RTN","IBCNSJ51",114,0)
I IB1'="",IB1<-IBEDT D
"RTN","IBCNSJ51",115,0)
.W !
"RTN","IBCNSJ51",116,0)
.S DIR(0)="Y",DIR("A",1)="An effective date later than the one you selected",DIR("A",2)="already exists for "_$P($G(^IBE(355.31,IBTYP,0)),U)_"."
"RTN","IBCNSJ51",117,0)
.S DIR("A")=" Are you sure you want to "_$S($D(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT)):"edit",1:"add")_" this earlier date for the category",DIR("B")="NO"
"RTN","IBCNSJ51",118,0)
.D ^DIR K DIR
"RTN","IBCNSJ51",119,0)
.W !
"RTN","IBCNSJ51",120,0)
Q (Y=1)
"RTN","IBCNSJ51",121,0)
;
"RTN","IBCNSJ51",122,0)
;/IB*2.0*631/vd - This section added (for US4555)
"RTN","IBCNSJ51",123,0)
ASK(ALLENT) ; Does the user want to Edit or Delete the selected category(ies)?
"RTN","IBCNSJ51",124,0)
; ALLENT - if set to 1, the user has selected a single entry
"RTN","IBCNSJ51",125,0)
; - if set to anything other than 1, the user has selected 'all' entries.
"RTN","IBCNSJ51",126,0)
;
"RTN","IBCNSJ51",127,0)
N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
"RTN","IBCNSJ51",128,0)
S DIR(0)="SA^E:Edit;D:Delete",DIR("B")="E"
"RTN","IBCNSJ51",129,0)
S DIR("A")="Do you want to Edit or Delete "_$S(ALLENT=1:"this entry",1:"entries")_"? "
"RTN","IBCNSJ51",130,0)
S DIR("?")="If you wish to EDIT "_$S(ALLENT=1:"this entry",1:"entries")_" enter 'E'dit. To DELETE "_$S(ALLENT=1:"this entry",1:"entries")_" enter 'D'elete."
"RTN","IBCNSJ51",131,0)
W ! D ^DIR
"RTN","IBCNSJ51",132,0)
Q $S("^D^E^"[(U_Y_U):Y,1:-1)
"RTN","IBCNSJ51",133,0)
;
"RTN","IBCNSJ51",134,0)
;/IB*2.0*631/vd - This section added (for US4555)
"RTN","IBCNSJ51",135,0)
DELETE(OPTALL,DDATE,IBREC) ; Delete specified Categories
"RTN","IBCNSJ51",136,0)
; INPUT: OPTALL - This can be either a specified coverage category or 'ALL'
"RTN","IBCNSJ51",137,0)
; DDATE - This is the selected effective date
"RTN","IBCNSJ51",138,0)
; IBREC - This is the record to be deleted for the selected coverage category, or it is NULL for 'ALL'
"RTN","IBCNSJ51",139,0)
N DELOP,IBREF,IBTY,TMP
"RTN","IBCNSJ51",140,0)
I OPTALL="ALL" D Q
"RTN","IBCNSJ51",141,0)
. ;
"RTN","IBCNSJ51",142,0)
. W !!,"The effective date of ",$$DAT1^IBOUTL(IBEDT)," will be deleted for the following coverage"
"RTN","IBCNSJ51",143,0)
. W !,"categories:"
"RTN","IBCNSJ51",144,0)
. S IBTY="" F S IBTY=$O(IBTYP(IBTY)) Q:IBTY="" D
"RTN","IBCNSJ51",145,0)
. . W !?5,$$GET1^DIQ(355.31,IBTY_",",.01) ; Display a Coverage Category.
"RTN","IBCNSJ51",146,0)
. . S IBREF=$O(^IBA(355.32,"APCD",+IBCPOL,IBTY,(-1*DDATE),""))
"RTN","IBCNSJ51",147,0)
. . S TMP(+IBCPOL,IBTY)=IBREF
"RTN","IBCNSJ51",148,0)
. ;
"RTN","IBCNSJ51",149,0)
. I '$D(TMP) D Q ; Only display if no Coverage Categories were found.
"RTN","IBCNSJ51",150,0)
. . W ! S DIR("A",1)="No Coverage Categories found for requested effective date."
"RTN","IBCNSJ51",151,0)
. . S DIR(0)="FAO",DIR("A")="Press RETURN to continue..." D ^DIR K DIR
"RTN","IBCNSJ51",152,0)
. ;
"RTN","IBCNSJ51",153,0)
. S DELOP=$$DELASK(DDATE) Q:'DELOP
"RTN","IBCNSJ51",154,0)
. ; Loop thru the TMP local global for IBCPOL and DELETE the list of related COVERAGE CATEGORIES.
"RTN","IBCNSJ51",155,0)
. S IBTY="" F S IBTY=$O(TMP(IBCPOL,IBTY)) Q:IBTY="" D
"RTN","IBCNSJ51",156,0)
. . S IBREF=TMP(IBCPOL,IBTY)
"RTN","IBCNSJ51",157,0)
. . D DELETIT(IBREF)
"RTN","IBCNSJ51",158,0)
. . D DELMSG(DDATE,IBTY)
"RTN","IBCNSJ51",159,0)
. K TMP
"RTN","IBCNSJ51",160,0)
;
"RTN","IBCNSJ51",161,0)
S DELOP=$$DELASK(DDATE) Q:'DELOP
"RTN","IBCNSJ51",162,0)
D DELETIT(IBREC) ; Delete the selected coverage category
"RTN","IBCNSJ51",163,0)
D DELMSG(DDATE,IBTYP) ; Report to user that category was deleted
"RTN","IBCNSJ51",164,0)
Q
"RTN","IBCNSJ51",165,0)
;
"RTN","IBCNSJ51",166,0)
;/IB*2.0*631/vd - This section added (for US4555)
"RTN","IBCNSJ51",167,0)
DELASK(DDATE) ; Prompt the user for DELETE question.
"RTN","IBCNSJ51",168,0)
N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
"RTN","IBCNSJ51",169,0)
W ! S DIR(0)="Y",DIR("A")="Are you sure you want to delete the effective date of "_$$DAT1^IBOUTL(DDATE)
"RTN","IBCNSJ51",170,0)
S DIR("B")="N" D ^DIR K DIR W !
"RTN","IBCNSJ51",171,0)
Q Y
"RTN","IBCNSJ51",172,0)
;
"RTN","IBCNSJ51",173,0)
;/IB*2.0*631/vd - This section added (for US4555)
"RTN","IBCNSJ51",174,0)
DELMSG(DDATE,CAT) ; Display message that a Coverage Category has been deleted.
"RTN","IBCNSJ51",175,0)
N CATNAM
"RTN","IBCNSJ51",176,0)
S CATNAM=$$GET1^DIQ(355.31,CAT_",",.01)
"RTN","IBCNSJ51",177,0)
W !,$$DAT1^IBOUTL(IBEDT)," for ",CATNAM," has been deleted."
"RTN","IBCNSJ51",178,0)
Q
"RTN","IBCNSJ51",179,0)
;
"RTN","IBCNSJ51",180,0)
;/IB*2.0*631/vd - This section added (for US4555)
"RTN","IBCNSJ51",181,0)
DELETIT(DA) ; Delete a coverage category for a selected date.
"RTN","IBCNSJ51",182,0)
; DA - passed in IEN (was variable IBREC)
"RTN","IBCNSJ51",183,0)
N DIDEL,DIK
"RTN","IBCNSJ51",184,0)
S DIK="^IBA(355.32,",DIDEL=355.32 D ^DIK ;Delete coverage category record for the specific date.
"RTN","IBCNSJ51",185,0)
K DIK
"RTN","IBCNSJ51",186,0)
Q
"RTN","IBCNSJ51",187,0)
;
"RTN","IBCNSM3")
0^11^B16082217^B15749953
"RTN","IBCNSM3",1,0)
IBCNSM3 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 4/7/03 9:56am
"RTN","IBCNSM3",2,0)
;;2.0;INTEGRATED BILLING;**6,28,85,211,251,399,506,516,631**;21-MAR-94;Build 11
"RTN","IBCNSM3",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNSM3",4,0)
;
"RTN","IBCNSM3",5,0)
% G EN^IBCNSM
"RTN","IBCNSM3",6,0)
;
"RTN","IBCNSM3",7,0)
AD ; -- Add new insurance policy
"RTN","IBCNSM3",8,0)
N X,Y,DO,DD,DA,DR,DIC,DIE,DIK,DIR,DIRUT,IBCNSP,IBCPOL,IBQUIT,IBOK,IBCDFN,IBAD,IBGRP,IBADPOL,IBCOVP,ANS,IBGNA,IBGNU
"RTN","IBCNSM3",9,0)
S IBCNSEH=$P($G(^IBE(350.9,1,4)),"^",1),IBQUIT=0,IBADPOL=1
"RTN","IBCNSM3",10,0)
D FULL^VALM1
"RTN","IBCNSM3",11,0)
S IBCOVP=$P($G(^DPT(DFN,.31)),"^",11)
"RTN","IBCNSM3",12,0)
I '$D(^DPT(DFN,.312,0)) S ^DPT(DFN,.312,0)="^2.312PAI^^"
"RTN","IBCNSM3",13,0)
;
"RTN","IBCNSM3",14,0)
D INS^IBCNSEH
"RTN","IBCNSM3",15,0)
; -- Select insurance company
"RTN","IBCNSM3",16,0)
; If one already exists for same co. ask are you sure you are
"RTN","IBCNSM3",17,0)
; adding a new one
"RTN","IBCNSM3",18,0)
S DIR(0)="350.9,4.06"
"RTN","IBCNSM3",19,0)
S DIR("A")="Select INSURANCE COMPANY",DIR("??")="^D ADH^IBCNSM3"
"RTN","IBCNSM3",20,0)
S DIR("?")="Select the Insurance Company for the policy you are entering"
"RTN","IBCNSM3",21,0)
D ^DIR K DIR S IBCNSP=+Y I Y<1 G ADQ
"RTN","IBCNSM3",22,0)
I $P($G(^DIC(36,+IBCNSP,0)),"^",2)="N" W !,"This company does not reimburse. "
"RTN","IBCNSM3",23,0)
I $P($G(^DIC(36,+IBCNSP,0)),"^",5) W !,*7,"Warning: Inactive Company" H 3 K IBCNSP G ADQ
"RTN","IBCNSM3",24,0)
I $$DUPCO^IBCNSOK1(DFN,IBCNSP,"",1) H 3
"RTN","IBCNSM3",25,0)
;
"RTN","IBCNSM3",26,0)
; -- see if can use existing policy
"RTN","IBCNSM3",27,0)
D SEL^IBCNSEH
"RTN","IBCNSM3",28,0)
S IBCPOL=$$LK^IBCNSM31(IBCNSP)
"RTN","IBCNSM3",29,0)
;
"RTN","IBCNSM3",30,0)
; IB*2.0*506 added IBKEY parameter (4th) to the NEW^IBCNSJ3 call (check user's security keys)
"RTN","IBCNSM3",31,0)
I IBCPOL<1 D NEW^IBCNSJ3(IBCNSP,.IBCPOL,,1)
"RTN","IBCNSM3",32,0)
I IBCPOL<1 G ADQ
"RTN","IBCNSM3",33,0)
;
"RTN","IBCNSM3",34,0)
; -- file new patient policy
"RTN","IBCNSM3",35,0)
;IB*2.0*516/baa - Use HIPAA Compliant fields
"RTN","IBCNSM3",36,0)
;S DIC("DR")=".18////"_IBCPOL_";1.09////7.02;1.05///NOW;1.06////"_DUZ
"RTN","IBCNSM3",37,0)
;/IB*2.0*631/vd - Replaced the original code which was accidentally stepped on by
"RTN","IBCNSM3",38,0)
; the IB*2.0*516 patch and caused an invalid value to appear in the SOI field when
"RTN","IBCNSM3",39,0)
; entering a new patient policy. (US7912)
"RTN","IBCNSM3",40,0)
S DIC("DR")=".18////"_IBCPOL_";1.09////1;1.05///NOW;1.06////"_DUZ
"RTN","IBCNSM3",41,0)
K DD,DO S DA(1)=DFN,DIC="^DPT("_DFN_",.312,",DIC(0)="L",X=IBCNSP D FILE^DICN K DIC S IBCDFN=+Y,IBNEW=1 I +Y<1 G ADQ
"RTN","IBCNSM3",42,0)
D BEFORE^IBCNSEVT
"RTN","IBCNSM3",43,0)
;
"RTN","IBCNSM3",44,0)
; -- Edit patient policy data
"RTN","IBCNSM3",45,0)
D PAT^IBCNSEH,PATPOL^IBCNSM32(IBCDFN)
"RTN","IBCNSM3",46,0)
;
"RTN","IBCNSM3",47,0)
; -- edit PLAN data if hold key
"RTN","IBCNSM3",48,0)
I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) G ADQ
"RTN","IBCNSM3",49,0)
I '$G(IBQUIT) D POL^IBCNSEH,EDPOL(IBCDFN)
"RTN","IBCNSM3",50,0)
I '$G(IBNEW) D AI^IBCNSP1
"RTN","IBCNSM3",51,0)
G ADQ
"RTN","IBCNSM3",52,0)
;
"RTN","IBCNSM3",53,0)
ADQ D COVERED^IBCNSM31(DFN,IBCOVP)
"RTN","IBCNSM3",54,0)
I $G(IBCDFN)>0 D AFTER^IBCNSEVT,^IBCNSEVT
"RTN","IBCNSM3",55,0)
I $G(IBCPOL)>0 D BLD^IBCNSM
"RTN","IBCNSM3",56,0)
S VALMBCK="R"
"RTN","IBCNSM3",57,0)
Q
"RTN","IBCNSM3",58,0)
;
"RTN","IBCNSM3",59,0)
EDPOL(IBCDFN) ; -- Edit GROUP PLAN specific info
"RTN","IBCNSM3",60,0)
I '$G(IBCDFN) G EDPOLQ
"RTN","IBCNSM3",61,0)
N DA,DR,DIE,DIC,IBAD,IBCPOL,IBDIF
"RTN","IBCNSM3",62,0)
S IBCPOL=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
"RTN","IBCNSM3",63,0)
L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G EDPOLQ
"RTN","IBCNSM3",64,0)
I IBCPOL D
"RTN","IBCNSM3",65,0)
.D SAVE^IBCNSP3(IBCPOL)
"RTN","IBCNSM3",66,0)
.S DIE="^IBA(355.3,",DA=IBCPOL
"RTN","IBCNSM3",67,0)
.;IB*2.0*516/baa - Use HIPAA Compliant fields
"RTN","IBCNSM3",68,0)
.;S DR="S IBAD=$P($G(^IBA(355.3,DA,0)),U,2),Y=$S(IBAD=0:""@55"",IBAD="""":""@1"",1:""@25"");@1;.02;@25;.03;.04;@55;6.02;6.03;.09;"
"RTN","IBCNSM3",69,0)
.S DR="S IBAD=$P($G(^IBA(355.3,DA,0)),U,2),Y=$S(IBAD=0:""@55"",IBAD="""":""@1"",1:""@25"");@1;.02;@25;2.01;2.02;@55;6.02;6.03;.09;"
"RTN","IBCNSM3",70,0)
.S DR=DR_".15;S Y=$S($$CATOK^IBCEMRA($P(^(0),U,14)):""@60"",1:""@65"");@60;.14;@65;.16;I '$$FTFV^IBCNSU31(X) S Y=""@66"";.17;@66;.13;.05;.12;.06;.07;.08//YES;"
"RTN","IBCNSM3",71,0)
.;
"RTN","IBCNSM3",72,0)
.I $D(IBREG),'$G(IBNEWP) S DR="S IBAD=$P($G(^IBA(355.3,DA,0)),U,2),Y=$S(IBAD=0:""@55"",IBAD="""":""@1"",1:""@25"");@1;.02;@25;D 3^IBCNSM31;D 4^IBCNSM31;@55;6.02;6.03;.09;"
"RTN","IBCNSM3",73,0)
.I $D(IBREG),'$G(IBNEWP) S DR=DR_".15;S Y=$S($$CATOK^IBCEMRA($P(^(0),U,14)):""@60"",1:""@65"");@60;.14;@65;.16;I '$$FTFV^IBCNSU31(X) S Y=""@66"";.17;@66;.13;.05;.12;.06;.07;.08//YES;"
"RTN","IBCNSM3",74,0)
.;
"RTN","IBCNSM3",75,0)
.D ^DIE
"RTN","IBCNSM3",76,0)
.D COMP^IBCNSP3(IBCPOL)
"RTN","IBCNSM3",77,0)
.I IBDIF D UPDATE^IBCNSP3(IBCPOL),UPDATPT^IBCNSP3(DFN,IBCDFN) I $$DUPPOL^IBCNSOK1(IBCPOL,1)
"RTN","IBCNSM3",78,0)
L -^IBA(355.3,+IBCPOL)
"RTN","IBCNSM3",79,0)
EDPOLQ Q
"RTN","IBCNSM3",80,0)
;
"RTN","IBCNSM3",81,0)
OK ; -- ask okay
"RTN","IBCNSM3",82,0)
S IBQUIT=0,DIR(0)="Y",DIR("A")=" ...OK",DIR("B")="YES" D ^DIR K DIR
"RTN","IBCNSM3",83,0)
I $D(DIRUT) S IBQUIT=1
"RTN","IBCNSM3",84,0)
S IBOK=Y
"RTN","IBCNSM3",85,0)
Q
"RTN","IBCNSM3",86,0)
;
"RTN","IBCNSM3",87,0)
ADH ; -- show existing policies for help
"RTN","IBCNSM3",88,0)
N DIR,DA,%A
"RTN","IBCNSM3",89,0)
W !!,"The patient currently has the following Insurance Policies"
"RTN","IBCNSM3",90,0)
D DISP^IBCNS
"RTN","IBCNSM3",91,0)
Q
"RTN","IBY631PO")
0^9^B6066647^n/a
"RTN","IBY631PO",1,0)
IBY631PO ;AITC/TAZ - Post-Installation for IB patch 631; 22-MAY-2018
"RTN","IBY631PO",2,0)
;;2.0;INTEGRATED BILLING;**631**;21-MAR-94;Build 11
"RTN","IBY631PO",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBY631PO",4,0)
;
"RTN","IBY631PO",5,0)
POST ; POST ROUTINE(S)
"RTN","IBY631PO",6,0)
N IBXPD,XPDIDTOT
"RTN","IBY631PO",7,0)
S XPDIDTOT=2
"RTN","IBY631PO",8,0)
;
"RTN","IBY631PO",9,0)
; Send site registration message to FSC
"RTN","IBY631PO",10,0)
D REGMSG(1)
"RTN","IBY631PO",11,0)
; Change the description & acronym for PURCHASED CARE CHOICE in SOI file [#355.12]
"RTN","IBY631PO",12,0)
D CHGSOI(2)
"RTN","IBY631PO",13,0)
;
"RTN","IBY631PO",14,0)
; Displays the 'Done' message and finishes the progress bar
"RTN","IBY631PO",15,0)
D MES^XPDUTL("")
"RTN","IBY631PO",16,0)
D MES^XPDUTL("POST-Install Completed.")
"RTN","IBY631PO",17,0)
Q
"RTN","IBY631PO",18,0)
;
"RTN","IBY631PO",19,0)
REGMSG(IBXPD) ; send site registration message to FSC
"RTN","IBY631PO",20,0)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
"RTN","IBY631PO",21,0)
D MES^XPDUTL("-------------")
"RTN","IBY631PO",22,0)
D MES^XPDUTL("Sending site registration message to FSC ... ")
"RTN","IBY631PO",23,0)
;
"RTN","IBY631PO",24,0)
I '$$PROD^XUPROD(1) D MES^XPDUTL(" N/A - Not a production account - No site registration message sent") G REGMSGQ
"RTN","IBY631PO",25,0)
D MES^XPDUTL("Sending site registration message to FSC ... ")
"RTN","IBY631PO",26,0)
D ^IBCNEHLM
"RTN","IBY631PO",27,0)
;
"RTN","IBY631PO",28,0)
REGMSGQ ;
"RTN","IBY631PO",29,0)
Q
"RTN","IBY631PO",30,0)
;
"RTN","IBY631PO",31,0)
CHGSOI(IBXPD) ; change the PURCHASED CARE CHOICE description & acronym in SOI file.
"RTN","IBY631PO",32,0)
N IBDATA,IBDFDA,IBERROR,IBFILE
"RTN","IBY631PO",33,0)
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
"RTN","IBY631PO",34,0)
D MES^XPDUTL("-------------")
"RTN","IBY631PO",35,0)
D MES^XPDUTL("Changing Description & Acronym for PURCHASED CARE CHOICE (PCC)")
"RTN","IBY631PO",36,0)
D MES^XPDUTL("to COMMUNITY CARE NETWORK (CCN) in the SOI File [#355.12] ... ")
"RTN","IBY631PO",37,0)
;
"RTN","IBY631PO",38,0)
; Get the internal EIN for the SOI record to be changed in the #355.12 file.
"RTN","IBY631PO",39,0)
S IBDFDA=$$FIND1^DIC(355.12,"","X","PURCHASED CARE CHOICE","C")
"RTN","IBY631PO",40,0)
I 'IBDFDA D G CHGSOIQ
"RTN","IBY631PO",41,0)
. D MES^XPDUTL(" The 'PURCHASED CARE CHOICE' does not exist in the SOI file [#355.12],")
"RTN","IBY631PO",42,0)
. D MES^XPDUTL(" ...Description and Acronym NOT CHANGED.")
"RTN","IBY631PO",43,0)
; Change the description & acronym for the SOI record in the #355.12 file.
"RTN","IBY631PO",44,0)
S IBFILE=355.12,IBDATA(.02)="COMMUNITY CARE NETWORK",IBDATA(.03)="CCN"
"RTN","IBY631PO",45,0)
I $$UPD^IBDFDBS(IBFILE,IBDFDA,.IBDATA,.IBERROR) D G CHGSOIQ
"RTN","IBY631PO",46,0)
. D MES^XPDUTL(" CHANGED the Description & Acronym for PURCHASED CARE CHOICE (PCC)")
"RTN","IBY631PO",47,0)
. D MES^XPDUTL(" in the SOI File to COMMUNITY CARE NETWORK (CCN).")
"RTN","IBY631PO",48,0)
;
"RTN","IBY631PO",49,0)
CHGSOIQ ;
"RTN","IBY631PO",50,0)
Q
"RTN","IBY631PO",51,0)
;
"VER")
8.0^22.2
"^DD",355.36,355.36,0)
FIELD^^.05^8
"^DD",355.36,355.36,0,"DT")
3190429
"^DD",355.36,355.36,0,"IX","B",355.36,.01)

"^DD",355.36,355.36,0,"IX","C",355.36,.02)

"^DD",355.36,355.36,0,"NM","CREATION TO PROCESSING TRACKING")

"^DD",355.36,355.36,.01,0)
DATE PROCESSED^RD^^0;1^S %DT="ESTXR" D ^%DT S X=Y K:X<1 X
"^DD",355.36,355.36,.01,1,0)
^.1
"^DD",355.36,355.36,.01,1,1,0)
355.36^B
"^DD",355.36,355.36,.01,1,1,1)
S ^IBA(355.36,"B",$E(X,1,30),DA)=""
"^DD",355.36,355.36,.01,1,1,2)
K ^IBA(355.36,"B",$E(X,1,30),DA)
"^DD",355.36,355.36,.01,3)
(No range limit on date)
"^DD",355.36,355.36,.01,21,0)
^^1^1^3190327^
"^DD",355.36,355.36,.01,21,1,0)
This field is the date and time that the insurance record was processed.
"^DD",355.36,355.36,.01,"DT")
3190429
"^DD",355.36,355.36,.02,0)
TYPE OF PROCESSING^S^1:No Touch to No Touch;2:No Touch to Human;3:Human to No Touch;4:Human to Human;^0;2^Q
"^DD",355.36,355.36,.02,1,0)
^.1
"^DD",355.36,355.36,.02,1,1,0)
355.36^C
"^DD",355.36,355.36,.02,1,1,1)
S ^IBA(355.36,"C",$E(X,1,30),DA)=""
"^DD",355.36,355.36,.02,1,1,2)
K ^IBA(355.36,"C",$E(X,1,30),DA)
"^DD",355.36,355.36,.02,1,1,3)
DO NOT DELETE
"^DD",355.36,355.36,.02,1,1,"%D",0)
^^2^2^3190328^
"^DD",355.36,355.36,.02,1,1,"%D",1,0)
This cross reference sorts the entries by the Type of Processing for
"^DD",355.36,355.36,.02,1,1,"%D",2,0)
easier reporting.
"^DD",355.36,355.36,.02,1,1,"DT")
3190321
"^DD",355.36,355.36,.02,3)
Enter the type of processing.
"^DD",355.36,355.36,.02,21,0)
^^1^1^3190327^
"^DD",355.36,355.36,.02,21,1,0)
This field is the type of processing from creation until processed.
"^DD",355.36,355.36,.02,23,0)
^^2^2^3190321^
"^DD",355.36,355.36,.02,23,1,0)
This field will be updated when the response is processed. It is based
"^DD",355.36,355.36,.02,23,2,0)
on how the insurance information was entered and validated.
"^DD",355.36,355.36,.02,"DT")
3190327
"^DD",355.36,355.36,.03,0)
SOURCE OF INFORMATION^P355.12'^IBE(355.12,^0;3^Q
"^DD",355.36,355.36,.03,3)
Enter the source of the information
"^DD",355.36,355.36,.03,21,0)
^^1^1^3190328^
"^DD",355.36,355.36,.03,21,1,0)
This field is the source of the original data input.
"^DD",355.36,355.36,.03,"DT")
3190328
"^DD",355.36,355.36,.04,0)
EIV AUTO-UPDATE^S^0:NO;1:YES;^0;4^Q
"^DD",355.36,355.36,.04,3)
Set to "YES" to indicate that this response resulted in an auto-update of the patient policy.
"^DD",355.36,355.36,.04,21,0)
^^1^1^3190327^
"^DD",355.36,355.36,.04,21,1,0)
This field indicates whether the transaction was auto-updated.
"^DD",355.36,355.36,.04,23,0)
^^2^2^3190327^
"^DD",355.36,355.36,.04,23,1,0)
This field is set to match the EIV AUTO UPDATE field of the IIV RESPONSE
"^DD",355.36,355.36,.04,23,2,0)
File (#365,.13).
"^DD",355.36,355.36,.04,"DT")
3190327
"^DD",355.36,355.36,.05,0)
EIV INQUIRY^NJ10,0^^0;9^K:+X'=X!(X>9999999999)!(X<1)!(X?.E1"."1.N) X
"^DD",355.36,355.36,.05,3)
Type a number between 1 and 9999999999, 0 decimal digits.
"^DD",355.36,355.36,.05,21,0)
^^1^1^3190321^
"^DD",355.36,355.36,.05,21,1,0)
This is the IEN of the inquiry record.
"^DD",355.36,355.36,.05,23,0)
^^3^3^3190321^
"^DD",355.36,355.36,.05,23,1,0)
This is the IEN of the IIV TRANSMISSION QUEUE File (#365.1). It is not a
"^DD",355.36,355.36,.05,23,2,0)
pointer since the IIV TRANSMISSION QUEUE File is purged and this
"^DD",355.36,355.36,.05,23,3,0)
information needs to remain in the database for historical purposes.
"^DD",355.36,355.36,.05,"DT")
3190327
"^DD",355.36,355.36,.06,0)
EIV RESPONSE^NJ10,0^^0;6^K:+X'=X!(X>9999999999)!(X<1)!(X?.E1"."1.N) X
"^DD",355.36,355.36,.06,3)
Type a number between 1 and 9999999999, 0 decimal digits.
"^DD",355.36,355.36,.06,21,0)
^^1^1^3190327^
"^DD",355.36,355.36,.06,21,1,0)
This is the IEN of the response record.
"^DD",355.36,355.36,.06,23,0)
^^3^3^3190321^
"^DD",355.36,355.36,.06,23,1,0)
This is the IEN of the IIV RESPONSE File (#365). It is not a pointer
"^DD",355.36,355.36,.06,23,2,0)
since the IIV RESPONSE File is purged and this information needs to
"^DD",355.36,355.36,.06,23,3,0)
remain in the database for historical purposes.
"^DD",355.36,355.36,.06,"DT")
3190327
"^DD",355.36,355.36,.07,0)
BUFFER^NJ10,0^^0;7^K:+X'=X!(X>9999999999)!(X<1)!(X?.E1"."1.N) X
"^DD",355.36,355.36,.07,3)
Type a number between 1 and 9999999999, 0 decimal digits.
"^DD",355.36,355.36,.07,21,0)
^^2^2^3190321^
"^DD",355.36,355.36,.07,21,1,0)
This is the IEN of the transaction in the INSURANCE VERIFICATION
"^DD",355.36,355.36,.07,21,2,0)
PROCESSOR File (#355.33).
"^DD",355.36,355.36,.07,23,0)
^^5^5^3190321^
"^DD",355.36,355.36,.07,23,1,0)
This is the IEN of the INSURANCE VERIFICATION PROCESSOR File (#355.33). It
"^DD",355.36,355.36,.07,23,2,0)
is not a pointer since the INSURANCE VERIFICATION PROCESSOR File can be
"^DD",355.36,355.36,.07,23,3,0)
purged
"^DD",355.36,355.36,.07,23,4,0)
and this information needs to remain in the database for historical
"^DD",355.36,355.36,.07,23,5,0)
purposes.
"^DD",355.36,355.36,.07,"DT")
3190327
"^DD",355.36,355.36,.08,0)
WHICH EXTRACT^S^1:BUFFER;2:APPT;3:NON-VERIFIED;4:EICD;5:REQUEST ELECTRONIC;6:ICB/VISTA;7:MBI;^0;8^Q
"^DD",355.36,355.36,.08,3)
Enter the code corresponding to the source of the Request
"^DD",355.36,355.36,.08,21,0)
^^2^2^3190327^
"^DD",355.36,355.36,.08,21,1,0)
This field identifies which data extract that the transmission record was
"^DD",355.36,355.36,.08,21,2,0)
generated from.
"^DD",355.36,355.36,.08,23,0)
^^4^4^3190327^
"^DD",355.36,355.36,.08,23,1,0)
This is a copy of the WHICH EXTRACT Field of the IIV TRANSMISSION QUEUE
"^DD",355.36,355.36,.08,23,2,0)
File (365.1,.1). It is not a pointer since the IIV TRANSMISSION QUEUE
"^DD",355.36,355.36,.08,23,3,0)
File is purged and this information needs to remain in the database for
"^DD",355.36,355.36,.08,23,4,0)
historical purposes.
"^DD",355.36,355.36,.08,"DT")
3190327
"^DD",365.1,365.1,.1,0)
WHICH EXTRACT^S^1:Buffer;2:Appt;3:Non-verified;4:EICD;5:REQUEST ELECTRONIC;6:ICB/VISTA;7:MBI REQUEST;^0;10^Q
"^DD",365.1,365.1,.1,3)
Enter a code from the list.
"^DD",365.1,365.1,.1,21,0)
^.001^2^2^3190312^^
"^DD",365.1,365.1,.1,21,1,0)
This field identifies which data extract that the transmission
"^DD",365.1,365.1,.1,21,2,0)
record was generated from.
"^DD",365.1,365.1,.1,23,0)
^^6^6^3190312^
"^DD",365.1,365.1,.1,23,1,0)
Patch IB*2*621 renamed data extract (#4)
"^DD",365.1,365.1,.1,23,2,0)
from "No Insurance" to "EICD".
"^DD",365.1,365.1,.1,23,3,0)
Patch IB*2*631 adds the following codes:
"^DD",365.1,365.1,.1,23,4,0)
5 = REQUEST ELECTRONIC
"^DD",365.1,365.1,.1,23,5,0)
6 = ICB/VISTA
"^DD",365.1,365.1,.1,23,6,0)
7 = MBI REQUEST
"^DD",365.1,365.1,.1,"DT")
3190312
"^DIC",355.36,355.36,0)
CREATION TO PROCESSING TRACKING^355.36
"^DIC",355.36,355.36,0,"GL")
^IBA(355.36,
"^DIC",355.36,355.36,"%",0)
^1.005^1^1
"^DIC",355.36,355.36,"%",1,0)
IB
"^DIC",355.36,355.36,"%","B","IB",1)

"^DIC",355.36,355.36,"%D",0)
^^4^4^3190321^
"^DIC",355.36,355.36,"%D",1,0)
This file will track transaction from creation until final processing.
"^DIC",355.36,355.36,"%D",2,0)
This file tracks insurance records that are processed through the
"^DIC",355.36,355.36,"%D",3,0)
INSURANCE VERIFICATION PROCESSOR (355.33), in addition to records that
"^DIC",355.36,355.36,"%D",4,0)
are processed via auto update.
"^DIC",355.36,"B","CREATION TO PROCESSING TRACKIN",355.36)

"BLD",11220,6)
9^
$END KID IB*2.0*631